C-----------------------------------------------------------------------
C	DM TREE Driver (Called from DM to use SDTREE) 
C		Returns TgtLen = -1 if no subdirectories, = 0 if no
C		change, or +(length of Target) if change.
C-----------------------------------------------------------------------

	Subroutine DM_TREE (CDIR, CDEV, Target, TgtLen, PBID, KBID,
	1				Highlight, VT300)

	Implicit Integer*4 (A-Z)
	Character*(*) CDIR, CDEV, Target
	Logical*1 Highlight, VT300
	Character*1 CC
                  
	Include 'SD_Common.Dat'
	Include 'SD_SMG.Dat'

	
C-----------------------------------------------------------------------

	SD_Highlight = Highlight
	SD_VT300 = VT300
	
	Do K = 1,Max_VMS_Dir_Depth
		Have_Display(K) = .FALSE.
		Have_Big_Display(K) = .FALSE.
		Name_Length(K) = 0
	End Do
	Current_Level = 1

	CDirLen = Lib$MatchC (']',CDIR)
	Current_Directory = CDIR(:CDirLen) 

	CDevLen = Lib$MatchC (':',CDEV)
	Current_Device = CDEV(:CDevLen) 
 
	Environment = Current_Device(:CDevLen)
	Environment(CDevLen+1:) = Current_Directory
	EnvLen = CDevLen + CDirLen
  
	Change = ' '
	ChgLen = 0
	TgtLen = 0


	Call SMG$Create_Virtual_Display (23,132, Wipe_Display)
	Call SMG$Paste_Virtual_Display (Wipe_Display,PBID,2,1)

	Call SDTree_Displays (PBID, KBID)

C	 	  Assign a channel to "Channel";
C
	Status = Sys$Assign (%Descr(Current_Device(:CDevLen)),
	1		%Ref(Channel),,)
C			NOTE THAT THE TRAILING COMMAS ARE REQUIRED

	IF (INDEX(Current_Directory(1:CDirLen),'.').EQ.0) THEN

	    CALL DIR1_READ('[000000]'//Current_Directory(2:CDirLen-1))

	ELSE

	    DO I=CDirLen-1,1,-1

		IF (Current_Directory(I:I).EQ.'.') GO TO 10

	    ENDDO

10	    Current_Directory(I:I) = ']'

	    CALL DIR1_READ(Current_Directory(1:CDirLen-1))
                                           
	ENDIF

	If (Bottom_File(1) .GE. Top_File(1)) then    ! we got something

		Call Dirn_Read

		ChgLen = 0

		CALL DISPLAY

C		   Terminate, clearing the pasted displays

100		If (ChgLen .GT. 0) then   ! We should signal.
			K = Lib$MatchC('[',Change)
			TgtLen = ChgLen - K + 11
			Target = Change(K:ChgLen)//'11AAAA.DIR'
			GoTo 9999
		Else If (ChgLen .LT. 0) then
		   If ((Cmd .EQ. 'a') .OR. (Cmd .EQ. 'A')) then
			Call DM_Gold_A
			ChgLen = 0
			Cmd = ' '
			Call Re_Display
			GoTo 100
		   Else If ((Cmd .EQ. 'p') .OR. (Cmd .EQ. 'P')) then
			Call DM_Print_Tree (Level_Display, 
	1			Highest_Level, 
	2			Current_Display_Length, Top_Display)

			ChgLen = 0
			Cmd = ' '
			Call Re_Display
			GoTo 100
		   Else
			GoTo 9999
		   End If	
		Else
			GoTo 9999
		End If

		GoTo 9999

	Else

C			Terminate, signaling no subdirectories
		TgtLen = -1
		Call SMG$Delete_Virtual_Display (Bottom_Display)
		GoTo 9999
	End If

9999	Continue


C 		Deassign the channel (note use of %Val);
	Status = Sys$Dassgn (%Val(Channel))
	Channel = -9999

	Call SMG$Begin_Pasteboard_Update (PBID)
	Call SMG$Pop_Virtual_Display (Wipe_Display, PBID)
	Do K = 1,Max_VMS_Dir_Depth
		If (Have_Display(K)) 
	1	   Call SMG$Delete_Virtual_Display (Level_Display(K))
		If (Have_Big_Display(K)) 
	1	   Call SMG$Delete_Virtual_Display (Big_Display(K))
	End Do
	Call SMG$End_Pasteboard_Update (PBID)
C 		Second End is needed if we selected something
C	Call SMG$End_Pasteboard_Update (PBID)
	If (SD_Star_Wide) then
		SD_Star_Wide = .FALSE.
		Call SMG$Change_Pbd_Characteristics (PBID, 80)
		Shift_Point = 2
	End If
	
	Return
	End

C-------------------------------------------------------------------C
C Print the Directory Tree
C-------------------------------------------------------------------C

	Subroutine DM_Print_Tree (Level_Display, Highest_Level,
	1	   	Level_Length, Top_Display)

        Implicit Integer*4 (A - Z)

        Include 'Common.Dat'

	Integer*4 Level_Display(Max_VMS_Dir_Depth), Highest_Level
	Integer*4 Level_Length, Top_Display
	
	Logical Special_Print, DEC_Standard

        Integer*2 NBytes
	Integer*4 Line_Index, Ver
	
	Character*81 Line
	Character*80 Line2
	Equivalence (Line(2:), Line2(1:))
	
	Character*22 File(3)
	Character*9 Trans_Table, Match_Table

	Character*(*) DEC_Printers
C 		List of printers which support line-drawing character set.
C 			Note trailing space
	Parameter (DEC_Printers = 'LN03 LA100 LP100 LA210 LA75 ')
	

	Character*(*) LDFont	! Load Line-Drawing Font
	Parameter (LDFont = ' '//Char(27)//'*0')
	Character*(*) PBold	! Print Bold
	Parameter (PBold = Char(27)//'[1m')
	Character*(*) PNormal	! Print Normal
	Parameter (PNormal = Char(27)//'[0m')
	
	Data File(1) /'SYS$LOGIN:DM$DIR.LIS;1'/
	Data File(2) /'SYS$LOGIN:DM$DIR.LIS;2'/
	Data File(3) /'SYS$LOGIN:DM$DIR.LIS;3'/
C-------------------------------------------------------------------C

	Match_Table = Char(1)//Char(4)//Char(5)//Char(10)//
	1		Char(3)//Char(11)//Char(13)//'`'//Char(0)
	
C 		Do we recognize the printer type as DEC "Standard"?
	Call Str$Trim(%Descr(Printer_Type),%Descr(Printer_Type),
	1			%Ref(NBytes))
	
	If (Index (DEC_Printers, Printer_Type(:NBytes)//' ') .GT. 0) then
		DEC_Standard = .TRUE.
	Else
		DEC_Standard = .FALSE.
	End If
	
	Special_Print = .TRUE.
	If (DEC_Standard) then
C 		Table for LN03 and other DEC Standard Printers
	    Trans_Table = Char(241)//Char(241)//Char(241)//Char(248)//
	1		  Char(237)//Char(244)//Char(247)//Char(224)//' '
C 
C 		Insert handling for other special printers here...
C	Else If (Printer_Type .EQ. 'ZZZZ') then
C	    Trans_Table = '...|\|.> '
	
	Else
C 		Table for Regular Line Printers
	    Trans_Table = '...|\|.> '
	    Special_Print = .FALSE.
	End If
	
	Line = Blanks


C		Try to open one of 3 available files
	Do 10 Ver = 1,3
  	Open (Unit=1, File=File(Ver), Status='Unknown', Err=10)
	GoTo 50
10	Continue
	Call Mess_Wait (' Your DM Print Queue is full.'//
	1	'  Try again after these directories are printed.')
	GoTo 900

C		We got a file.  Now do the first line.
	
50	Call SMG$Read_From_Display (%Ref(Top_Display)
	1	,%Descr(Line2),,%Ref(1))

	If (Special_Print) then
	    If (DEC_Standard) then
		Write (1,101) LDFont//PBold//Line2//PNormal
101			Format (A)
	
C 		Insert handling for other special printers here...
C	    Else If (Printer_Type .EQ. 'ZZZZ') then
C		Write (1,101) Whatever//Line//Whatever
	    End If
	
	Else		! Line Printer
		Write (1,100) Line
100		Format (A)
	End If
	
	Write (1,100)			  ! Empty line

	If (Highest_Level .LE. 4) then
		ND = Highest_Level
	Else
		ND = 4
	End If

C		The rest of the lines...
	Do 200 Line_Index = 2, Level_Length
	  Line = Blanks
	  Do 190 N = 1,ND
	    Call SMG$Read_From_Display (%Ref(Level_Display(N))
	1	,%Descr(Line2((N*20)-19:)),,%Ref(Line_Index))

190	  Continue
		Call STR$Translate (%Descr(Line2),%Descr(Line2),
	1		%Descr(Trans_Table),%Descr(Match_Table))
		IF (Line2 .EQ. ' ') then
			Write (1,100)
		Else
			Write (1,100) Line
		End If

200	Continue

C		How about above 4?

	If (Highest_Level .LE. 4) then
		GoTo 800
	Else
		ND = Highest_Level - 4
	End If

	Write (1,100) ' '//Char(12)       ! FF
	Write (1,100)			  ! Empty line

C		The rest of the lines...
 	Do 300 Line_Index = 2, Level_Length
	  Line = Blanks
	  Do 290 N = 1,ND
	    Call SMG$Read_From_Display (%Ref(Level_Display(N+4))
	1	,%Descr(Line2((N*20)-19:)),,%Ref(Line_Index))

290	  Continue
		Call STR$Translate (%Descr(Line2),%Descr(Line2),
	1		%Descr(Trans_Table),%Descr(Match_Table))
		IF (Line2 .EQ. ' ') then
			Write (1,100)
		Else
			Write (1,100) Line
		End If

300	Continue


800	Close (Unit=1)

	Call Str$Trim(%Descr(Print_Command),%Descr(Print_Command),
	1			%Ref(NBytes))

	Exit_Com = Print_Command(:NBytes)
	Exit_Com(NBytes+2:) = File(Ver)	
	Call Do_Hidden_DCL

900	Return
	End

