Initial commit

unix/terinq_old.f

@@ -0,0 +1,152 @@
+	program terinq
+
+	implicit none
+	character name*64, gdev*32, pps*32, line*78
+	integer rows, i, ll, l, cols
+
+	integer getppid
+
+	line=' '
+	call sys_get_cmdpar(line, i)
+	if (i .eq. 0) i=1
+
+	call sys_loadenv
+	call sys_temp_name('terinq',name)	
+	open(1,file=name,status='unknown',carriagecontrol='list'
+	1,err=9)
+	goto 10
+
+9	type *,'can not open ',name
+	stop 'CHO failed'
+
+10	if (line(1:i) .eq. 'gethost') then ! read host information from file
+	  read (1,'(a)',end=3) line
+	  rewind 1
+	  i=index(line,'(')
+	  if (i .ne. 0) then
+	    line=line(i+1:)
+	    i=index(line, ')')
+	    if (i .gt. 1) then
+	      call sys_setenv('REMOTEHOST', line(1:i-1))
+	    endif
+	  endif
+3	  line=' '
+	  i=1
+	endif
+
+	call cho_inq(line(1:i), gdev, pps, cols, rows)
+	ll=0
+        if (gdev .ne. ' ') then
+          call sys_setenv('CHOOSER_GDEV',gdev)
+	  call sys_setenv('PGPLOT_DEV','/'//gdev)
+          call str_trim(gdev, gdev, l)
+          line='Display type: '//gdev(1:l)
+          ll=l+14
+	endif
+	call cho_vpp_cups(pps)
+       	if (pps .ne. ' ') then
+          if (ll .gt. 0) then
+            line(ll+1:)=',  '
+            ll=ll+3
+          endif
+          call str_trim(pps, pps, l)
+          line(ll+1:)='Default Printer: '//pps(1:l)
+          ll=ll+l+17
+          call sys_setenv('CHOOSER_DEST',pps(1:l))
+	  call sys_setenv('CHOOSER_PDEV','PS')
+          write(1,'(a)') 'alias lp lp -d '//pps(1:l)
+          write(1,'(a)') 'alias lpr lpr -P '//pps(1:l)
+          write(1,'(a)') 'alias lpl lp -o landscape -d '//pps(1:l)
+	endif
+        if (cols .ne. 0 .or. rows .ne. 0) then
+          if (ll .gt. 0) then
+            line(ll+1:)=',  '
+            ll=ll+3
+          endif
+	  if (rows .eq. 0) then
+	    rows=24
+	  else
+	    write(1, '(a,i2)') 'stty rows ',rows
+	  endif
+	  if (cols .eq. 0) then
+	    cols=80
+	  else
+	    write(1, '(a,i2)') 'stty columns ',cols
+	  endif
+          write(line(ll+1:),'(a,i4,a,i3)') 'Window size:',cols,'x',rows
+          ll=ll+20
+        endif
+        if (ll .gt. 0) then
+          type *
+          type *,line(1:ll)
+          type *
+        endif
+90	continue
+	write(1,'(2a)') '/usr/bin/rm ',name
+	close(1)
+	call sys_saveenv
+	call sys_clean_tmp
+	end
+
+
+	subroutine sys_clean_tmp
+
+        implicit none
+        
+	parameter fp=54, dp=41, dl=6
+! these parameters depend on the formatting of the ls -l command
+!                                         <-dl->
+!-rw-r--r--   1 lnslib   system       131 May 16 11:00 /tmp/.cho_lnslib.1603
+!                                         ^ dp         ^ fp
+        
+	character file*128, user*32, line*128, line0*128
+        integer i, j, np, l, lf, lun, cnt, pid, iret, pidlist(100)
+
+        call sys_temp_name('clnup', file)
+        call str_trim(file, file, lf)
+	call sys_delete_file(file)
+	call sys_getenv('USER', user)
+	call str_trim(user, user, l)
+        call sys_cmd('ps > '//file(1:lf)
+	1         //';ls -alt /tmp/.*_'//user(1:l)//'.* >> '//file(1:lf))
+	call sys_get_lun(lun)
+	line0=' '
+	open(lun, file=file, status='old', readonly, err=9)
+        read(lun, '(a)', end=2) line ! read title
+        j=0
+5       read(lun, '(a)', end=2) line
+        read(line, *, err=7, end=7) pid
+        if (pid .ne. 0 .and. j .lt. 100) then
+          j=j+1
+          pidlist(j)=pid
+          goto 5
+        endif
+7       np=j
+        cnt=0
+10      read(lun, '(a)', end=2) line
+	if (line(fp+1:fp+5) .ne. '/tmp/') goto 9
+	call str_trim(line,line,l)
+	if (line(dp+1:dp+dl) .ne. line0(dp+1:dp+dl)) then
+	  cnt=cnt+1
+	  line0=line
+	endif
+	if (cnt .gt. 2 .and. l .gt. fp) then
+          do i=l,l-9,-1
+	    if (line(i:i) .lt. '0' .or. line(i:i) .gt. '9') then
+              if (line(i:i) .ne. '.') goto 10
+	      if (i .lt. l) then
+                read(line(i+1:l), *) pid
+                do j=1,np
+                  if (pid .eq. pidlist(j)) goto 10
+                enddo
+	        call sys_delete_file(line(fp+1:l))
+                goto 10
+	      endif
+	    endif
+	  enddo
+	endif
+        goto 10
+2	close(lun)
+9	call sys_free_lun(lun)
+	call sys_delete_file(file)
+	end