! @(#)showcode.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:46:18
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! Midas procedure  showcode.prg  to display the related procedure code for
!                                a Midas command
! K. Banse	910514, 920401
!
! use as @ showcode comstr flag
! where         comstr = command/qualif
!               flag = o/t for original or translated code
!
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/param p1 load/image c "Enter command: "
define/param p2 o c "Enter flag = original/translated: "
! 
show/comm {p1} 			!get procedure name in key OUTPUTC
write/out 			!one blank line
! 
!  handle @ procedure
! 
write/keyw inputc " " all
define/local mm/i/1/1 0
! 
if outputc(1:2) .eq. "@ " then
   mm = m$index(outputc(3:)," ")
   if mm .le. 0 then
      mm = m$len(outputc(3:))+3
   else
      mm = 1+mm
   endif
   write/keyw inputc {outputc(3:{mm})}
   if p2(1:1) .eq. "T" then
      translate/show MID_PROC:{inputc}
      return
   else
      define/local direc/c/1/12 MID_PROC:
      goto open_proc
   endif
!
!  handle @% procedure
!
elseif outputc(1:3) .eq. "@% " then
   mm = m$index(outputc(4:)," ")
   if mm .le. 0 then
      mm = m$len(outputc(4:))+4
   else
      mm = 2+mm
   endif
   write/keyw inputc {outputc(4:{mm})}
   if p2(1:1) .eq. "T" then
      translate/show MID_PROC:{inputc}
      return
   else
      define/local direc/c/1/12 MID_PROC:
      goto open_proc
   endif
! 
!  handle @a procedure
! 
elseif outputc(1:3) .eq. "@a " then
   mm = m$index(outputc(4:)," ")
   if mm .le. 0 then
      mm = m$len(outputc(4:))+4
   else
      mm = 2+mm
   endif
   write/keyw inputc {outputc(4:{mm})}
   if p2(1:1) .eq. "T" then
      translate/show APP_PROC:{inputc}
      return
   else
      define/local direc/c/1/12 APP_PROC:
      goto open_proc
   endif
! 
!  handle @s procedure
! 
elseif outputc(1:3) .eq. "@s " then
   mm = m$index(outputc(4:)," ")
   if mm .le. 0 then
      mm = m$len(outputc(4:))+4
   else
      mm = 2+mm
   endif
   write/keyw inputc {outputc(4:{mm})}
   if p2(1:1) .eq. "T" then
      translate/show STD_PROC:{inputc}
      return
   else
      define/local direc/c/1/12 STD_PROC:
      goto open_proc
   endif
! 
! 
!  handle @c procedure
! 
elseif outputc(1:3) .eq. "@c " then
   mm = m$index(outputc(4:)," ")
   if mm .le. 0 then
      mm = m$len(outputc(4:))+4
   else
      mm = 2+mm
   endif
   write/keyw inputc {outputc(4:{mm})}
   if p2(1:1) .eq. "T" then
      translate/show CON_PROC:{inputc}
      return
   else
      define/local direc/c/1/12 CON_PROC:
      goto open_proc
   endif
elseif outputc(1:3) .eq. "pri" then
   return				!primitive command
endif
! 
write/out "No Midas procedure for this command... "
return
! 
open_proc:
define/local fc/i/1/2 0,0
define/local fname/c/1/120 " " all
! 
write/keyw fname {direc}{inputc}
open/file {fname} READ fc
if fc(1) .lt. 0 then
   open/file {fname}.prg READ fc
   if fc(1) .lt. 0 then
      write/out Could not open {fname} ...
      return/exit
   endif
   write/keyw fname {fname}.prg 
endif
close/file {fc(1)}
! 
write/_out {fname}			!display whole ASCII file