C-------------------------------------------------------------------C
C  Directory Management        January 1983                         C
C  Written by John C. Hayre, Texas Instruments                      C
C  Send suggestions and/or complaints to:                           C
C                                                                   C
C               Veeco Integrated Automation			    C
C               10355 Brockwood Rd				    C
C               Dallas, Texas 75238                                 C
C               (Attention John Hayre)                              C
C                                                                   C
C  Phone: 214-349-8482                                              C
C-------------------------------------------------------------------C
C MainLine for 'Directory Management':                              C
C                                                                   C
C Purpose: List the files in a directory and allow the user to      C
C look at individual files, or look at other directories.  The 24th C
C line on the CRT gives a list of single letter commands that can   C
C be envoked.  The following is a list of these commands:           C
C                                                                   C
C   PF2 Instructions for user to use this program                   C
C   E   Edit file                                                   C
C   F   FMS editor
C   V   View a file or directory                                    C
C   T   Tag files for a multiple file operation                     C
C   U   Untag files (undo the I command above)                      C
C   M   Show more information about the files                       C
C   L   Show less information about the files (Makes Screen faster) C
C   Q   Quit                                                        C
C   X   Exit
C   G   Purge this directory                                        C
C   R   Rename a file                                               C
C  *D   Delete a file(s) or directory(s) or both                    C
C  *C   Copy file(s) to a file                                      C
C                                                                   C
C  * - Multiple file operations that may use include/exclude        C
C  * - Included files can also be used with any DCL spawned command C
C      Dcl is spawned by 1st typing the Gold, 7 keys.  Instructions C
C      for spawning DCL are given after typing GOLD 7.              C
C                                                                   C
C In addition to these single letter commands, a DCL command may be C
C done by entering Gold 7.  After the DCL command is finished the   C
C program returns to the directory that the user was examining.     C
C-------------------------------------------------------------------C
C 4.1 RTGREGORY : 4/10/85 Removed vt100 check from setchan.mar and 
C		increased the length of the file-name variable (log_name)
C------------------------------------------------------------------
C Program version 4 : June 17, 1983  John C. Hayre                  C
C   Put version number on screen and made '2' be show function as   C
C   well as 's'.                                                    C
C-------------------------------------------------------------------C
C Program version 3 : Dec 9, 1982  John C. Hayre                    C
C   Fixed some problems with copy.  Also changed the showfile find  C
C   function to display all the strings sought on the screen with   C
C   reverse video.                                                  C
C-------------------------------------------------------------------C
C Program version 2 : Aug 9, 1982  John C. Hayre                    C
C   Fixed several problems that came about due to version 3.0 of VMSC
C-------------------------------------------------------------------C
C Program version 3 : Oct 7, 1982  John C. Hayre                    C
C   Added the ability to do DCL from the program and return.  This  C
C   is accomplished by using the VMS 3.0 Spawn command.             C
C-------------------------------------------------------------------C
       Program DM
       Implicit Integer*4 (A - Z)
       integer*2 ttch1
       Character*1 Com
       Character*1 Tchar
       Character*50 Log_Name
C --------------------------  changed from 20 to 50 for version 4.1 VMS
       Character*128 Restore_Name
       Character*250 Symbol
       Character*80 Exit_Com, original_dir, current_dir
       Include 'common.include'
       COMMON /TTCH/ TTCH1
       EXTERNAL Lib$_Nosuchsym
       integer*4 temp1, temp2
C-------------------------------------------------------------------C
C
       Version = 6 !  Current version number. . . . . . . 
       file_attr_pos = 35	!where 'more' info starts on the line
C
C-------------------------------------------------------------------C
c       call smg$create_pasteboard( paste_id, 'sys$output', temp,
c     -  temp, 0)
c       call smg$create_virtual_display( 22, 60, attributes_id)
c       call smg$create_virtual_display( 22, 80, names_id)
c       call smg$paste_virtual_display( names_id, paste_id, 1, 1)
C
C virtual display for file attributes
C
       Stat = SYS$Assign('TT', TTCh1,,)
       If (.not. Stat) Call Lib$Stop(%Val(Stat))
       DownLast = 1 ! <<<< should be 1
       IncluCount = 0 ! No include files
       SchrSize = 0
       Bright = Char(27)//'[1m'
       Dull = Char(27)//'[0m'
       Blinking = Char(27)//'[5m'
       Revideo = Char(27)//'[7m'   
       UnderLine = Char(27)//'[4m'
       SvTerminal = Char(27)//'8'
       ReTerminal = Char(27)//'7'
       SmallScreen = Char(27)//'[1;22r'
       LargeScreen = Char(27)//'[1;24r'    
       Epage = Char(27)//'[2J'
       Blanks = ' '
       Stat = Lib$GET_Symbol('DM$wildcard', wildcard)
9998   Call Writel(SvTerminal, 24, 1)
c	autowrap off
       Call Writel(Char(27)//'[?7l', 24, 1)
       Stat = Lib$GET_Symbol('DM$SYM1', Symbol)
       If (.not. Stat) Call Lib$Stop(%Val(Stat))
       stat = Lib$GET_Symbol('original_dir', original_dir)
       Stat = Lib$GET_Symbol('current_dir', current_dir)

       If (Symbol(1:1) .NE. 'Y') then ! Do this block on nth entry to dm
c	 Call Sys$SetdDir( %Val(0), %Val(0), current_dir)
    	   !read where we are in file system
    	 Decode(5, 2000, Symbol(5:9)) Cursorline	
         Decode(5, 2000, Symbol(10:14)) TopLine
         Decode(5, 2000, Symbol(15:19)) StkIndex
         Decode(5, 2000, Symbol(20:24)) Srchsize
         Decode(5, 2000, Symbol(25:29)) Fast
         Decode(5, 2000, Symbol(30:34)) Forward
         Decode(80, 2001, Symbol(71:150)) Search
         If (Symbol(1:1) .EQ. 'D') then ! returned from DCL 
           Print *, 'DCL Complete.  Enter a key to continue.'
           Call GET1Char(Com, 1)		! Let them see DCL results
	   Call purgechar			! purge the typeahead buffer in
						! case the user hit a keypad key
         End If
         Stat = Lib$GET_Symbol('DM$SYM2', Symbol)
         J = 1
         Do I = 1, 15
           Decode(1, 2002, Symbol(J:J)) FStack(I)
           Decode(1, 2002, Symbol(J+1:J+1)) FastStack(I)
           Decode(5, 2000, Symbol(J+2:J+6)) Cstack(I)
           Decode(5, 2000, Symbol(J+7:J+11)) TStack(I)
           J = J + 12
         End Do
2000     Format(5I5)
2001     Format(A80)
2002     Format(I1)
       end if ! symbol <> 'Y'

       If (Symbol(1:1) .EQ. 'Y') then	!first time thru program
         Symbol(1:1) = 'N'				    !point
         Stat = Lib$Set_Symbol('DM$SYM1', Symbol)
         CursorLine = 4
         TopLine = 1
         Forward = 1
         Stkindex = 0
         SrchSize = 0
         Fast = 1
         GenSrch = .TRUE. ! parameters for showfile
         SrchPat = '****' ! parameters for showfile
         SrchSiz = 4      ! parameters for showfile
         stat = Lib$GET_Symbol('original_dir', original_dir)
c    	 print *, original_dir, 'assign symbols'
       End If
c       print *, current_dir, 'current_dir'
c       call GET1char(cmd)
c	 80 col. screen
	Call Writel(Char(27)//'[?3l', 24, 1)
       Pur = 1 ! purge the keyboard on 1st entry
C-------------------------------------------------------------------C
C GET default directory, read all files into Ld array               C
C-------------------------------------------------------------------C
100    Call Sys$SetdDir(%Val(0),%Val(0),DName)    !GET Default dir
       Call RealDir(Dname, RealName)   ! [aaa.bbb] --> [aaa]bbb.DIR
       Call PreDir(RealName, PreName)  ! [aaa]bbb.DIR --> [aaa]
       Call GETLd(RealName, EX)! Put the file names, in 'LD' 
C    	print *, dname, realname,prename
C    	call GET1char(cmd)
       If (Ex .EQ. 1) then 
         Call Fix_CRT   
         Exit_Com = 'zzzz' 
         Goto 9999
       End If
       Call Write24                    ! Write 24 lines
       Call Lib$Set_Cursor(Cursorline, 1) ! position cursor
       If ((CursorLine + TopLine) .LT. 5 ) Call Dnarrow 
       If (Ld(CursorLine + TopLine - 1)(1:20) .EQ. 
     -   '                    ') Call DnArrow
C-------------------------------------------------------------------C
C Loop here waiting for valid command.                              C
C-------------------------------------------------------------------C
200    Call Lib$Set_Cursor(CursorLine, 1) ! Position cursor 
       Call Writel(Bright, Cursorline, 1)
       cl = topline + cursorline - 1

       if (lib$matchc (cmd, 'Ii') .gt. 0) then
         Call Writel(Ld(cl)(1:file_attr_pos), CursorLine, 1)
       else
         Call Writel(Ld(cl), CursorLine, 1)
       end if !remove file info

       if (fast .le. 0) then !PRINT MORE INFO
         Call Writel(Ldattributes(cl), CursorLine, file_attr_pos)
       end if
       Call Writel(Dull, Cursorline, 80)
       Call GET1Char_with_clock_ticking(CMD, Pur)
       Pur = 1 ! allow type ahead except very 1st time
       If (Clean23 .EQ. 1) then
         Call Fix23 ! it makes clean23 = 0
         Call Lib$Set_Cursor(CursorLine, 1) ! Position cursor 
       End If
C-------------------------------------------------------------------C
C Handle command:                                                   C
C-------------------------------------------------------------------C
       If (CMD .Eq. Char(1)) then !Control A - page forward
         SavFor = Forward
         Forward = 1
         Call Page
         Forward = SavFor
       End If
       If (CMD .Eq. Char(2)) then !Control B - page back
         SavFor = Forward
         Forward = 0
         Call Page
         Forward = SavFor
       End If
       If (CMD .Eq. Char(23)) then !Control W - refresh
    	 call write24
       End If
       If (CMD .EQ. '8') Call PAGE       ! Page Key
       If (CMD .EQ. '3') Call POPSTACK
       If (CMD .EQ. Char(26)) CMD = 'X'

       If (lib$matchc (CMD, 'Aa') .gt. 0 ) call top_of_screen
       If (lib$matchc (CMD, 'Zz') .gt. 0 ) call bottom_of_screen

       If (lib$matchc (CMD, 'Qq') .gt. 0 ) then
         Call Fix_CRT
    	 call lib$set_symbol('current_DIR', original_dir)
c    	 print *, original_dir, 'quitting to origin'
c    	call GET1char(cmd)
         Exit_Com = 'zzzz'!
         Goto 9999  ! Exit this program
       End If
       If (lib$matchc (CMD, 'Xx') .gt. 0 ) then
         Call Fix_CRT
c    	 print *, current_dir
         If (lib$matchc ( '[000000]', current_dir) .eq. 0 ) then
c     	   print *, 'qutting to here -', current_dir

    	   Call Sys$SetdDir(%Val(0),%Val(0),current_dir)
    	   call lib$set_symbol('current_DIR', current_dir)
    	 end if
         Exit_Com = 'zzzz'!
C    	 Call GET1Char(Com, 0)
         Goto 9999  ! Exit this program
       End If
       If (CMD .EQ. '4') then
         Forward = 1     ! forward mode
         DownLast = 1
       End If
       If (CMD .EQ. '5') then
         Forward = 0     ! reverse mode
         DownLast = 0
       End If
       If ((LIB$MATCHC(CMD,'-=').GT. 0)) then 
         Call UpArrow
       End If
       If ((LIB$MATCHC(CMD,' 0').GT. 0).or.(cmd.eq.char(13))) then 
         If (DownLast .EQ. 1) then 
           Call DnArrow    ! 0, blank, and <cr> are like the down arrow char
         Else
           Call UpArrow
         End If
       End If
       If (lib$matchc (CMD, 'Pp') .gt. 0 ) Call Prnt
       If (lib$matchc (CMD, 'VvSs') .gt. 0 ) then
         Call SHOWIT
       End If
       If (CMD .EQ. '2') Call SHOWIT
       If (CMD .EQ. '$') then 
	 Call DCL(Startover, Exit_Com) ! Do DCL Command
	 If (Startover .EQ. 1) goto 9999
       End If
       If (CMD .EQ. '%') then 
	 Call DCL(Startover, Exit_Com) ! Do DCL Command
	 exit_com = '%'//exit_com
	 If (Startover .EQ. 1) goto 9999
       End If
       If (lib$matchc (CMD, 'Dd') .gt. 0 ) Call Delit
C-----------------------------------------------------------------------
C Interface to any DCL program  Letters left = abhjknouvwyz!%^&()<>
C	Current Support is:
C	    a. EDT (e)
C	    b. FMS (f)
C	    e. @ <com file> (@)
C-----------------------------------------------------------------------
       If (lib$matchc(CMD, '@bBEeFf').GT. 0 ) then
         Call Envoke_DCL_Command(Exit_Flag, Exit_Com, Symbol, CMD)
         If (Exit_Flag .EQ. 1) Goto 9999 ! don't what happened
       End If
C-----------------------------------------------------------------------
       If (lib$matchc (CMD, 'Uu') .gt. 0 ) Call Exclude
       If (lib$matchc (CMD, '*Tt') .gt. 0 ) then
         Call Include(TopLine + CursorLine - 1, 1)
       End If
       If (lib$matchc (CMD, 'Gg') .gt. 0 ) then
         Call Purge(Startover)
         If (Startover .EQ. 1) then 
c          Cursorline = FirstUsed
c          Topline = 1
           Goto 100 
         End If
       End If
       If (lib$matchc (CMD, 'Cc') .gt. 0 ) then
         Call Copy(Startover)
         If (Startover .Eq. 1) Goto 100  
       End If
       If (lib$matchc (CMD, 'Rr') .gt. 0 ) then
         Call Rename(Startover)
         If (Startover .Eq. 1) Goto 100
       End If
       If (lib$matchc (CMD, 'MmLl') .gt. 0 ) then
         Call Toggle(StartOver, 1)
         If (StartOver .EQ. 1) Goto 100
       End If
       If (lib$matchc (CMD, 'Ii') .gt. 0 ) Call Info
       If (lib$matchc (CMD, 'Ww') .gt. 0 ) then
	 Call wild( startover)
	 if (startover .eq. 1) goto 100
       end if ! W

C---------------------------------------------------
C  Caution Hack starts here!!!!!!!!!!!!!!!!!!!!!!!!!
C	Commands past here assume the keyboard is in
C	applications mode for VMS 4.x
C---------------------------------------------------
       If (CMD .EQ. Char(27)) then ! Esc key - more keys follow
         Startover = 0
         CMD = ' '
         Call GET1Char(Com, 0) ! Ignore the next char
         Call GET1Char(Com, 0) ! GET the character of interest
         If (Com .EQ. 'A') Call UpArrow ! Was it <UP ARROW> ?
         If (Com .EQ. 'B') Call DnArrow ! Was it <DOWN ARROW>?
         If (Com .EQ. 'Q') Call WritHelp !PF2 key
         If (Com .EQ. 's') Call popstack !3 key
         If (Com .EQ. 'p') then !0 key move one line
           If (DownLast .EQ. 1) then 
             Call DnArrow    ! like down arrow char
           Else
             Call UpArrow
           End If
         End If
         If (Com .EQ. 'x') Call page	 !8 key
         If (Com .EQ. 't') then !forward 4
    	   forward = 1
    	   downLast = 1
    	 end if
         If (Com .EQ. 'u') then ! back 5
    	   forward = 0
    	   downLast = 0
    	 end if 
         If (Com .EQ. 'r') call showit ! 2 show
         If (Com .EQ. 'R') Call ShowSrch ! Show 'SEARCH' string-PF3 key pressed
         If (Com .EQ. 'S') then   !PF4 key pressed
	   Call Fix_CRT
	   If (lib$matchc ( '[000000]', current_dir) .eq. 0 ) then
	     Call Sys$SetdDir(%Val(0),%Val(0),current_dir)
	     call lib$set_symbol('current_DIR', current_dir)
	   end if
	   Exit_Com = 'zzzz'!
	   Goto 9999  ! Exit this program
	 end if
         If (Com .EQ. 'm') then   !KP minus key pressed
	   call top_of_screen
	 end if
         If (Com .EQ. 'l') then   !KP comma key pressed
	   call bottom_of_screen
	 end if

	 if (com .eq. '1') then   !FIND key pressed
	      Call GET1Char(Com, 0)
	      if (com .eq. '~') then
		Call FindStrg 	! Show 'SEARCH' string
	      end if
	 end if !function key

	 if (com .eq. '5') then   !PREV SCREEN key pressed
	      Call GET1Char(Com, 0)
	      if (com .eq. '~') then
		 temp1 = forward
		 temp2 = downLast 
		 forward = 0
		 downLast = 0
		 Call page
		 forward = temp1
		 downLast = temp2
	      end if
	 end if !function key

	 if (com .eq. '6') then   !NEXT SCREEN key pressed
	      Call GET1Char(Com, 0)
	      if (com .eq. '~') then
		 temp1 = forward
		 temp2 = downLast 
		 forward = 1
		 downLast = 1
		 Call page
		 forward = temp1
		 downLast = temp2
	      end if
	 end if !function key

	 if (com .eq. '2') then			!GREY fxn key pressed 
	      Call GET1Char(Com, 0)
	      if (com .eq. '8') then		!HELP key 28
	        Call GET1Char(Com, 0)		!discard '~' key
	        call WritHelp 
	      end if
	      if (com .eq. '1') then		!F10 Exit key
	        Call GET1Char(Com, 0)		!discard '~' key
        	Call Fix_CRT
        	If (lib$matchc ( '[000000]', current_dir) .eq. 0 ) then
    		  Call Sys$SetdDir(%Val(0),%Val(0),current_dir)
	    	  call lib$set_symbol('current_DIR', current_dir)
    		end if
	        Exit_Com = 'zzzz'
	        Goto 9999  ! Exit this program
	      end if
	 end if !function key
         If (Com .EQ. 'P') then			! Gold key entered
           Call GET1Char(Com, 0) ! GET the next one 
	   if (lib$matchc (com, 'mM') .gt. 0) then ! spawn mail/edit
	     print *, largescreen, epage	
	     call writel('Enter Mail ...', 1, 1)
	     call Save_Stack ('E')
	     exit_com = '%mail/edit'
	     goto 9999
           End If

	   if (lib$matchc (com, 'sS') .gt. 0) then ! sfo file name
	     print *, largescreen, epage	
	     call getname( Ld( topline + cursorline -1), TempName, type)
	     call Save_Stack ('E')
	     exit_com = '% sfo '//TempName
	     goto 9999
           End If

	   if (lib$matchc (com, 'eE') .gt. 0) then ! call eve
	     print *, largescreen, epage	
	     call getname( Ld( topline + cursorline -1), TempName, type)
	     call Save_Stack ('E')
	     exit_com = '% eve '//TempName
	     goto 9999
           End If

	   if (lib$matchc (com, 'dD') .gt. 0) then ! get full directory on file
	     call getname( Ld( topline + cursorline -1), TempName, type)
	     if (type .eq. 0) then  !only do this on a file
	       print *, largescreen, epage	
	       call Save_Stack ('D')
	       exit_com = '% dir/full '//TempName
	       goto 9999
	     else
	       call mess( 'DMM does dir/full only on files.')
	     end if
           End If

           If (Com .EQ. '4') then		! Go to bottom of Ld array
             TopLine = LastLine - 15
             If (TopLine .LT. 1) TopLine = 1
             CursorLine = LastLine - TopLine + 1
             Call Write24
           End If
           If (Com .EQ. '5') Call GoTop		! Go to top of Ld array
           If (Com .EQ. '7') then 
             Call DCL(Startover, Exit_Com)	! Do DCL Command
             If (Startover .EQ. 1) goto 9999
           End If
           If (Com .EQ. Char(27)) then		! another escape char
             Call GET1Char(Com, 0)		! Skip over next char
             Call GET1Char(Com, 0)		! GET char of interest
             If (Com .EQ. 'R') Call FindStrg	! GET 'SEARCH' & show it
	     if (com .eq. 'w') then		!GOLD 7 LETS YOU ENTER DCL 
		    call dcl(startover, exit_com)
		    if (startover .eq. 1) goto 9999
	     end if
	     if (com .eq. 'u') call gotop
	     if (com .eq. 't') then
		 TopLine = LastLine - 15
		 If (TopLine .LT. 1) TopLine = 1
		 CursorLine = LastLine - TopLine + 1
		 Call Write24
	     End If
           End If
         End If
       End If
       Goto 200
9999   Continue ! exit the entire program
       call writel (epage, 1, 1)
	if (exit_com(1:1) .eq. '%') then
	  exit_com (1:1) = ' '
          Stat = Lib$Set_Symbol('DM$wildcard', wildcard)
	  Stat = Lib$Set_Symbol('DM$command', exit_com)
c    	  call lib$set_symbol('original_DIR', original_dir)
	else
	  if (exit_com(1:4) .eq. 'zzzz') then
	    Stat = Lib$Set_Symbol('DM$command', 'goto getout')
	  else
	    call lib$spawn (exit_com)
	    goto 9998
	  end if
	end if !GO OUT TO DCL AND RUN A COMMAND
       End
