  ! This software DLINES.F90 is part of the Compaq Visual Fortran kit.
  ! 
  ! This software is provided as an example that demonstrates a particular
  ! feature/function of the licensed product. The software is not intended to
  ! provide a complete solution to any application problem but rather is provided
  ! as a teaching mechanism.
  ! 
  ! Users may incorporate any part of this sample into their own source after 
  ! making appropriate changes to make it suitable for the intended application.

  ! This sample program takes convert Debug lines to IFDEF metacommands.
  ! It uses COM to drive Microsoft Developer Studio to edit the source file.
  ! The COM interfaces defined in DSAPP.F90 are taken from 
  !  ..\DevStudio\SharedIDE\Bin\devshl.dll.
  ! The COM interfaces defined in DSTEXT.F90 are taken from 
  !  ..\DevStudio\SharedIDE\Bin\devedit.pkg.
  !
  ! This program is invoked with the following command line:
  !	dlines inputsource outputsource debugchar ifdefname
  !
  !		inputsource  - file name of the input source file
  !					   NOTE: the source file must use fixed form
  !		outputsource - file name of the output source file
  !		debugchar    - the debug character in the source file to
  !                      replace with IFDEF metacommands
  !		ifdefname    - the name to use with the IFDEF metacommands
  !
  ! Any arguments not provided on the command line will be prompted for.
  !
	  
    PROGRAM DLINES
	  USE DFLIB
	  USE DFWIN
	  USE DSAPP
	  USE DS_TEXT, AVOID_DUPS1 => $IGenericDocument_Save, &
				   AVOID_DUPS2 => $IGenericDocument_Close, &
				   AVOID_DUPS3 => IID_IGenericDocument, &
				   AVOID_DUPS4 => dsSaveChangesNo
	  USE DLOBJS
	  USE DFCOMTY
	  USE DFCOM
	  USE DFAUTO
      IMPLICIT NONE                       

	! Command line arguments
	  CHARACTER (LEN = MAX_PATH) :: inputfile
	  CHARACTER (LEN = MAX_PATH) :: outputfile
	  CHARACTER (LEN = 1)        :: debugchar
	  CHARACTER (LEN = MAX_PATH) :: ifdefname
	
	! Variables
	  INTEGER*4 status
	  INTEGER*4 savestatus
	  INTEGER*4 lastLine
	  INTEGER*4 currentLine
	  LOGICAL   inIFDEF
	  CHARACTER (LEN = 1) :: firstchar
	  CHARACTER (LEN = 1) :: linefeed
	  CHARACTER (LEN = MAX_PATH+31) :: ifdefLine
	  CHARACTER (LEN = 11) :: endifLine
	  CHARACTER (LEN = 11) :: endendifLine

	! Variant arguments
	  TYPE (VARIANT) :: vExtend
	  TYPE (VARIANT) :: vSaveChanges
	  TYPE (VARIANT) :: vFilename

	! Determine if program arguments have been specified on the command line
	! If not, prompt the user
	  IF (NARGS() > 1) THEN
		  CALL GETARG(1_2, inputfile)
	  ELSE
		  PRINT '(A30)', ' Enter input source file name:'
		  READ 	(*,*) inputfile
	  END IF

	  IF (NARGS() > 2) THEN
		  CALL GETARG(2_2, outputfile)
	  ELSE
		  PRINT '(A31)', ' Enter output source file name:'
		  READ 	(*,*) outputfile
	  END IF

	  IF (NARGS() > 3) THEN
		  CALL GETARG(3_2, debugchar)
	  ELSE
		  PRINT '(A28)', ' Enter debug line character:'
		  READ 	(*,*) debugchar
	  END IF

	  IF (NARGS() > 4) THEN
		  CALL GETARG(4_2, ifdefname)
	  ELSE
		  PRINT '(A18)', ' Enter IFDEF name:'
		  READ 	(*,*) ifdefname
	  END IF

	! Initialize variables
	  inIFDEF = .FALSE.
	  linefeed = CHAR(10)
	  ifdefLine = "!DEC$IF DEFINED (" // TRIM(ifdefname) // ")" // linefeed
	  endifLine = "!DEC$ENDIF" // linefeed
	  endendifLine = linefeed // "!DEC$ENDIF"

	! Initialize variants
	  CALL VariantInit(vExtend)
	  vExtend%VT = VT_I4
	  vExtend%VU%LONG_VAL = dsExtend
	  CALL VariantInit(vFilename)
	  vFilename%VT = VT_BSTR
	  bstrFilename = ConvertStringToBSTR(outputfile)
	  vFilename%VU%PTR_VAL = bstrFilename
	  CALL VariantInit(vSaveChanges)
	  vSaveChanges%VT = VT_I4
	  vSaveChanges%VU%LONG_VAL = dsSaveChangesNo

	! Initialize object pointers;  This is necessary in order for the
	! program to release all objects when it is done
	  CALL COMINITIALIZE(status)
	  CALL INITOBJECTS()

	! Create a Developer Studio Application object
      CALL COMCREATEOBJECT ("MSDev.Application", dsappl, status)
	  CALL Check_Status(status, " Unable to create Microsoft Developer Studio object")
      status = AUTOSETPROPERTY(dsappl, "Visible", .TRUE.)

	! Traverse the Developer Studio object hierarchy to get a pointer to the
	! ITextSelection interface
	  CALL COMQUERYINTERFACE(dsappl, IID_IApplication, dsiappl, status)
	  CALL Check_Status(status, " Unable to get Application object; Aborting")
	  status = $IApplication_GetDocuments(dsiappl, dsdocs)
	  CALL Check_Status(status, " Unable to get Documents object; Aborting")
	  CALL COMQUERYINTERFACE(dsdocs, IID_IDocuments, dsidocs, status)
	  CALL Check_Status(status, " Unable to get IDocuments object; Aborting")
	  status = $IDocuments_Open(dsidocs, inputfile, ppDocument=dsdoc)
	  CALL Check_Status(status, " Unable to open input file; Aborting")
      status = AUTOGETPROPERTY(dsdoc, "Selection", dstextsel, VT_DISPATCH)
	  CALL Check_Status(status, " Unable to get TextSelection object; Aborting")
	  CALL COMQUERYINTERFACE(dsdoc, IID_IGenericDocument, dsigendoc, status)
	  CALL Check_Status(status, " Unable to get IGenericDocument object; Aborting")
	  CALL COMQUERYINTERFACE(dstextsel, IID_ITextSelection, dsitextsel, status)
	  CALL Check_Status(status, " Unable to get ITextSelection object; Aborting")

	! Search the entire source file for the DEBUG char in column 1
	  status = $ITextSelection_EndOfDocument(dsitextsel)
	  status = $ITextSelection_GetCurrentLine(dsitextsel, lastLine)
	  status = $ITextSelection_StartOfDocument(dsitextsel)
	  status = 0
	  DO WHILE (status == 0)
		  status = $ITextSelection_StartOfLine(dsitextsel)
		  status = $ITextSelection_CharRight(dsitextsel, vExtend)
		  IF (status == 0) THEN
			  status = $ITextSelection_GetText(dsitextsel, firstchar)
			  IF (firstchar == debugchar) THEN
				  status = $ITextSelection_SetText(dsitextsel, " ")
					IF (.NOT. inIFDEF) THEN
					    status = $ITextSelection_StartOfLine(dsitextsel)
						status = $ITextSelection_SetText(dsitextsel, ifdefLine)
						inIFDEF = .TRUE.
					END IF
			  ELSE
				  IF (inIFDEF) THEN
					    status = $ITextSelection_StartOfLine(dsitextsel)
						status = $ITextSelection_SetText(dsitextsel, endifLine)
						inIFDEF = .FALSE.
				  END IF
			  END IF
		  END IF
		  status = $ITextSelection_GetCurrentLine(dsitextsel, currentLine)
		  IF (currentLine == lastLine) THEN 
			  status = 1
		  ELSE 
			  status = $ITextSelection_LineDown(dsitextsel)
		  END IF
	  END DO

	! Special case for DEBUG line as last line in the source file
	  IF (inIFDEF) THEN
		status = $ITextSelection_EndOfDocument(dsitextsel)
		status = $ITextSelection_SetText(dsitextsel, endendifLine)
	  END IF

	! Save the changes to the output file, and exit Developer Studio
	  status = $IGenericDocument_Save(dsigendoc, vFilename, pSaved=savestatus)
	  status = $IGenericDocument_Close(dsigendoc, vSaveChanges, pSaved=savestatus)
	  status = $IApplication_Quit(dsiappl)

	! Release all objects
	  CALL RELEASEOBJECTS()
	  CALL COMUNINITIALIZE()

    END PROGRAM

	SUBROUTINE Check_Status(olestatus, errorMsg)
	  USE DLOBJS
      IMPLICIT NONE                       

	  INTEGER*4 olestatus
	  CHARACTER (LEN = *) :: errorMsg

	  IF (olestatus >= 0) THEN
		  RETURN
	  END IF

	! Error handling code
	  CALL RELEASEOBJECTS()
	  WRITE (*, '(A, "; OLE error status = 0x", Z8.8, "; Aborting")') TRIM(errorMsg), olestatus
	  CALL SLEEPQQ(5000)
	  CALL EXIT(-1)

    END SUBROUTINE
