program	libed

      implicit	none
cc
cc Purpose:	Provide an interactive, screen oriented display of selected
cc		CMS Library elements.
cc
      include	'libed.fin/list'
      include	'($ssdef)'

c  CMS callable interface hooks and goodies.
      include	'cmsdef.fin/list'
      integer*4	maxlib
      parameter	(maxlib = 10)
      record	/library_data_block/	libdb(1:maxlib)	! allow for multiple libraries.
      record	/fetch_data_block/	fetdb

      character*255	library
      character*79	element
      integer		cms_status, rtl_status

c  callback routine(s) for CMS.
      integer	add_element_to_display
      external	add_element_to_display

c  home made functions.
      integer*4	getlog, chklen
      external	getlog, chklen

c  SMG related stuff.
      integer*4	smg_stat
      integer*4	i

      record	/display/	display(1:maxlib)
      integer*4		num_windows, max_on_screen, max_window_size, max_height
      integer*4		window, last_window
      character*132	label
      character*80	text
      integer*4		pb_line/2/, pb_col/2/
      integer*4		pb_id				! the PasteBoard ID.
      integer*4		old_mode
      integer*4		saved_display_id		! for saving screen.
      integer*4		control, prompt			! display ID's.
      integer*4		kb_id				! the KeyBoard ID.

      include	'($iodef)'	! IO def stuff for modifying smg$read_chars.

      include	'($smgdef)'	! screen management parameters.
      integer*4		blink_bold
      parameter	(	blink_bold = smg$m_blink+smg$m_bold )

      integer*4	terminator_set(1:2)
      integer*4	terminator_mask(1:8)	! 32 bytes of mask, all characters are
      data (terminator_mask(i), i=1,8) / 8*'FFFFFFFF'x / ! terminators.

      include	'smg_refs.fin'

c  program data.
      logical		done / .false. /


c  CLI functions and parameters
      integer*4  	cli$present,	cli$get_value
      external	 	cli$present,	cli$get_value

      integer*4		cli$dcl_parse,	cli$dispatch
      external		cli$dcl_parse,	cli$dispatch

      integer*4		cli_status
      integer*4		qual_status

      include 'disk$pg22:[uxmerritt.test]clidefs.fin'

      integer*4		terminator

      integer	lib$stop, lib$signal
      external	lib$stop, lib$signal
c  error statuses for LIB$SIGNAL and LIB$STOP.
      integer*4	libed_no_lib, libed_err_ref, libed_no_matches
      external	libed_no_lib, libed_err_ref, libed_no_matches

cc
cc Loop through all the element spec's on the command line, validate the
cc CMS Library, and create a virtual display for the element names.
      num_windows = 0
      do while (cli$get_value('ELEMENT', element))
         num_windows = num_windows + 1
         display(num_windows).element = element

cc   Get the name of the library to be looked at.  (if not specified, it
cc   will be CMS$LIB.)
         cli_status = cli$get_value('LIBRARY', display(num_windows).library)
         cli_status = cli$get_value('GENERATION',
     +			display(num_windows).generation)

         cms_status = cms$set_library(libdb(num_windows), 
     +				      display(num_windows).library, )

         call make_string( libdb(num_windows).descriptor, library )
         display(num_windows).library = library

cc     If the library can't be found/accessed, signal the problem.
         if (cms_status .ne. %loc(cms$_libset)) then
            rtl_status = lib$signal(libed_err_ref)
            num_windows = num_windows - 1

cc     Otherwise, create a display for the menu portion.  Label the display
cc     with the CMS Library's name and the generation spec that was provided.
          else
            smg_stat = 
     +	smg$create_virtual_display( 1, 78, display(num_windows).id, 
     +					smg$m_border )

            smg_stat = smg$get_display_attr( 
     +		display(num_windows).id, display(num_windows).height,
     +		display(num_windows).width )

            label = 
     +		library(1:min(display(num_windows).width,chklen(library)))//
     +		', '//display(num_windows).generation 
            smg_stat = smg$label_border( display(num_windows).id, 
     +		label(1:min(chklen(label),display(num_windows).width)) )

         endif

      enddo

cc
cc Loop through all the element spec's for the valid CMS Libraries.  Put
cc the element names on the associated virtual display.
      do i = 1, num_windows

c    make SMG be quiet till we're done.
         smg_stat = smg$begin_display_update(display(i).id)

cc   Call CMS with the element and generation specification.  (wildcards
cc   and group names may result in more than one invocation of the output
cc   routine.)
         cms_status = cms$show_generation( 
     +		libdb(i),
     +		add_element_to_display, display(i),
     +		display(i).element(1:chklen(display(i).element)),
     +		display(i).generation(1:chklen(display(i).generation)),
     +		, , , ,
     +		 )

c   see how big the display ended up being, since ADD_ELEMENT_TO_DISPLAY
c   can change it's size.
         smg_stat = smg$get_display_attr( display(i).id, display(i).height,
     +				       display(i).width )

c   let SMG update the display/screen if needed.
         smg_stat = smg$end_display_update(display(i).id)
         display(i).line = 1
         display(i).column = 1
      enddo

cc
cc Create the pasteboard for the terminal.
      smg_stat = smg$create_pasteboard( pb_id )
      smg_stat = smg$control_mode( pb_id, , old_mode )
      if ( iand(old_mode, smg$m_notabs) .eq. 0) then
         smg_stat = smg$control_mode( pb_id, old_mode + smg$m_notabs )
      endif

c  make shur that spurious messages don't zap our screen.
      smg_stat = smg$set_broadcast_trapping( pb_id )

cc Create the virtual keyboard.
      smg_stat = smg$create_virtual_keyboard( kb_id )
      smg_stat = smg$set_keypad_mode( kb_id, 1 )

      do i = 1, num_windows
         max_height = max(max_height, display(i).height)
      enddo

      if ((max_height+1) * num_windows .lt. 21) then
         max_on_screen = num_windows
       else
         max_on_screen = min(num_windows, 3)
      endif

      max_window_size = 21/max_on_screen

cc Paste up the displays that will fit on the terminal.
      do i = 1, num_windows
         display(i).bottom = min(max_window_size, display(i).height)
         if (i .le. max_on_screen) then
            smg_stat = smg$paste_virtual_display( 
     +		display(i).id, pb_id, pb_line, pb_col )

            display(i).pb_line = pb_line
            display(i).pb_col = pb_col
            pb_line = pb_line + display(i).bottom + 1
         endif
c         smg_stat = smg$set_display_scroll_region( display(i).id )
      enddo

cc Create a display for the getting control info - cursor, etc.
      smg_stat = smg$create_virtual_display( 1, 80, control, smg$m_border )
      smg_stat = smg$put_chars( control, 'Press ?, PF2, or "HELP" for Help',
     + 			1, 40, , )
cc Paste up the control display (it must not be occluded).
      smg_stat = smg$paste_virtual_display( control, pb_id, 24, 1 )

cc
cc Loop until done:  wait for user input. 
      terminator_set(1) = '00000020'x		! 32 bytes in mask.
      terminator_set(2) = %loc(terminator_mask)	! address of mask.

      last_window = 0
      window = 1

      done = num_windows .le. 0

      do while ( .not. done )
         if (window .ne. last_window) then
            if (last_window .ne. 0) then
               call move_to_field( libed_clear, display(last_window) )
            endif
            call move_to_field( libed_set, display(window) )
            last_window = window
         endif

         terminator = 0
         smg_stat = smg$read_string( 	kb_id, text,
     + 					, 1, 
     + 		io$m_escape+io$m_nofiltr+io$m_noecho+io$m_trmnoecho, ,
     + 					,
     + 					,
     + 					terminator, control )

cc   ^W will refresh the screen.
         if ( terminator .eq. smg$k_trm_ctrlw ) then
            smg_stat = smg$repaint_screen( pb_id )

cc   The cursor keys (or ^P, ^N, ^F, ^B) will move to and highlite the next
cc   element in the given display.
          else if ( (terminator .eq. smg$k_trm_up) .or.
     + 		    (terminator .eq. smg$k_trm_ctrlp)  ) then
            call move_to_field( libed_up, display(window) )

          else if ( (terminator .eq. smg$k_trm_down) .or.
     + 		    (terminator .eq. smg$k_trm_ctrln) ) then
            call move_to_field( libed_down, display(window) )

          else if ( (terminator .eq. smg$k_trm_left) .or.
     + 		    (terminator .eq. smg$k_trm_ctrlb) ) then
            call move_to_field( libed_left, display(window) )

          else if ( (terminator .eq. smg$k_trm_right) .or.
     + 		    (terminator .eq. smg$k_trm_ctrlf) ) then
            call move_to_field( libed_right, display(window) )

cc   PF2 gets help from a VMS help library.
          else if ((terminator .eq. smg$k_trm_pf2) .or.
     +		   (terminator .eq. smg$k_trm_help)) then
            smg_stat = smg$save_physical_screen( pb_id, saved_display_id )
            call vms_help( pb_id, ' ' )
            smg_stat = smg$restore_physical_screen( pb_id, saved_display_id )

          else if   (terminator .eq. smg$k_trm_pf4) then 
            smg_stat = smg$snapshot( pb_id )

cc   Keypad "0" switches to the next virtual display.
          else if   (terminator .eq. smg$k_trm_kp0) then 
            window = window + 1
            if (window .gt. num_windows) window = 1

          else if ( terminator .eq. smg$k_trm_cr ) then
            smg_stat = smg$ring_bell( display(window).id )

cc   ^Z means exit.
          else if ( terminator .eq. smg$k_trm_ctrlz ) then
            done = .true.

c    if we had an error, to heck with the display - type out the problem.
          else if ( .not. smg_stat ) then
            type 222, smg_Stat
222         format( ' %LIBED-E-SMGERR, smg error: ', z8.8 )
            smg_stat = smg$ring_bell( display(window).id )
c            call wait( 1000 )

cc   "v" or a "V" will "VIEW" the element.
          else if ((text(1:1).eq. 'v') .or. (text(1:1).eq. 'V')) then
            call view( pb_id, display(window), libdb(window) )

cc   "z" or a "Z" will "ZOOM" in on the element's attributes.
          else if ((text(1:1).eq. 'z') .or. (text(1:1).eq. 'Z')) then
            call zoom( pb_id, display(window), libdb(window) )

cc   "?" will give a mini help box.
          else if ( text(1:1) .eq. '?' ) then
            call help( pb_id )

cc   Anything else gets a bell.
          else
            smg_stat = smg$ring_bell( display(window).id )
            
         endif

         smg_stat = smg$set_cursor_abs( display(window).id, 24, 1 )

      enddo

cc
cc When done, reset the cursor and delete the pasteboard.
      smg_stat = smg$set_cursor_abs( control, 24, 1 )
      smg_stat = smg$delete_pasteboard( pb_id )

      end

      subroutine help ( paste_board_id )

      implicit	none
cc
cc Purpose:	Create a small help display.

      integer*4		paste_board_id

      integer*4		kb_id				! the KeyBoard ID.

      integer*4	chklen
      external	chklen

      include	'($iodef)'	! IO def stuff for modifying smg$read_chars.

      include	'($smgdef)'	! screen management parameters.
      integer*4		blink_bold
      parameter	(	blink_bold = smg$m_blink+smg$m_bold )

      integer*4		smg_stat

      include	'smg_refs.fin'

      integer		menu_size
      parameter	(	menu_size = 3 )

      character*40	text
      character*40	menu_text(1:menu_size)
      integer*4		start_row(1:menu_size), start_col(1:menu_size)
      integer*4		attributes(1:menu_size)
      integer*4		i

      integer*4		help_menu

c        12345678 0 2345678 0 2345678 0 2345678 0
      data( menu_text(i), i = 1,menu_size) /
     + 	'Use arrow keys (^,v,<,>) to make a ',
     + 	'  selection.  ^Z to quit.',
     +  'Type any character to leave Help.' /

cc create a display for the help info.
      smg_stat = smg$create_virtual_display( 3, 35, help_menu,
     + 			smg$m_border )

      smg_stat = smg$label_border( help_menu, 'Help' )

cc   fill up the menu.
      do i = 1, menu_size
         text = menu_text(i)
         smg_stat = smg$put_line( help_menu, text )
      enddo

      smg_stat = 
     + 	smg$paste_virtual_display( help_menu, paste_board_id, 3, 5 )

      smg_stat = smg$create_virtual_keyboard( kb_id )

      smg_stat = smg$read_string( 	kb_id, text,
     + 					, 1, 
     + 		io$m_escape+io$m_nofiltr+io$m_noecho+io$m_trmnoecho, ,
     + 					,
     + 					,
     + 					, )

      smg_stat = smg$delete_virtual_keyboard( kb_id )

      smg_stat = smg$pop_virtual_display( help_menu, paste_board_id )

      end