!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubedag_list
  use cubetools_parameters
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubedag_parameters
  use cubedag_link_type
  use cubedag_list_columns
  use cubedag_list_types
  use cubedag_toc_types
  use cubedag_messaging
  use cubeadm_cubeid_types
  !
  public :: list
  private
  !
  type :: list_comm_t
    type(option_t),           pointer :: comm
    type(cubeid_arg_t),       pointer :: commarg
    type(option_t),           pointer :: index
    type(keywordlist_comm_t), pointer :: index_arg
    type(option_t),           pointer :: file
    ! Specific to LIST
    type(option_t),           pointer :: columns
    type(keywordlist_comm_t), pointer :: column_arg
    type(option_t),           pointer :: page
    ! Specific to LIST /TOC
    type(option_t),           pointer :: toc
    type(keywordlist_comm_t), pointer :: toctopic_arg
    type(option_t),           pointer :: variable
  contains
    procedure, public  :: register => cubedag_list_register
    procedure, private :: parse    => cubedag_list_parse
    procedure, private :: main     => cubedag_list_main
  end type list_comm_t
  type(list_comm_t) :: list
  !
  type :: list_user_t
    ! Common parts
    type(cubeid_user_cube_t) :: ucube  ! CubeID pattern, if any
    integer(kind=code_k)     :: index
    logical                  :: dofile
    character(len=file_l)    :: file
    logical                  :: dotoc
    ! Specific to LIST
    type(cubedag_list_user_t) :: def
    ! Specific to LIST /TOC
    type(cubedag_toc_user_t) :: toc
  contains
    procedure, private :: toprog => cubedag_list_user_toprog
  end type list_user_t
  !
  type :: list_prog_t
    type(cubedag_link_t) :: optx
    character(len=16)    :: optname
    integer(kind=4)      :: olun
    logical              :: dotoc
    ! Specific to LIST
    type(cubedag_list_prog_t) :: def
    ! Specific to LIST /TOC
    type(cubedag_toc_prog_t) :: toc
  contains
    procedure, private :: do => cubedag_list_do
  end type list_prog_t
  !
contains
  !
  subroutine cubedag_list_command(line,error)
    !---------------------------------------------------------------------
    ! Support for command
    !  DAG\LIST
    !---------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(list_user_t) :: user
    !
    call list%parse(line,user,error)
    if (error) return
    call list%main(user,line,error)
    if (error) return
  end subroutine cubedag_list_command
  !
  subroutine cubedag_list_register(list,error)
    use cubetools_setup_types
    use cubedag_allflags
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(list_comm_t), intent(inout) :: list
    logical,            intent(inout) :: error
    !
    type(cubeid_arg_t)   :: cubearg
    type(standard_arg_t) :: stdarg
    type(keywordlist_comm_t)  :: keyarg
    character(len=*), parameter :: rname='LIST>REGISTER'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'LIST','[cube]',&
         'List the cubes in the default index or the given index',&
         'LIST is used for a quick look to cube headers, in a more or&
         & less detailed format. A medium-sized format is used by&
         & default, this can be changed with option /COLUMNS. If the&
         & list is too large it can be displayed page by page with&
         & option /PAGE. The list can be output to an ASCII file with&
         & option /FILE.',&
         cubedag_list_command,&
         list%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Cube identifier pattern',  &
         strg_emp,&
         code_arg_optional,  &
         [flag_any], &
         code_read_none, &
         code_access_any,&
         list%commarg,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'INDEX','IndexName',&
         'Override the default index to be listed',&
         strg_emp,&
         list%index,error)
    if (error) return
    call keyarg%register( &
         'IndexName',  &
         'Name of the index to be listed', &
         strg_emp,&
         code_arg_mandatory, &
         indexname, &
         .not.flexible, &
         list%index_arg,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'TOC','topic',&
         'Table Of Contents of the index',&
         'A summary of the different values of each topic is made&
         &, plus a final summary of all the combinations (setups).&
         By default, all topics are used. The table of contents is also&
         & saved in a SIC structure. The default name for the&
         & structure is TOC%, this can be changed by using the option&
         & /VARIABLE. The content of the structure is updated after&
         & each call to the command LIST /TOC. One must take care&
         & that subsequent calls to FIND can lead to values in TOC%&
         & that are inconsistent with the actual index.',&
         list%toc,error)
    if (error) return
    call keyarg%register(&
         'topic', &
         'Topic(s) over which build TOC',&
         strg_emp, &
         code_arg_unlimited,&
         cubedag_list_toc_keys, &
         .not.flexible, &
         list%toctopic_arg,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'PAGE','',&
         'Page through the list',&
         strg_emp,&
         list%page,error)
    if (error) return
    !
    call cubetools_register_option(&
         'COLUMNS','col1 col2 ... coln',&
         'Define columns to be listed',&
         strg_emp,&
         list%columns,error)
    if (error) return
    call keyarg%register( &
         'column',  &
         'Column(s) to be listed', &
         strg_emp,&
         code_arg_unlimited, &
         list_column_names, &
         .not.flexible, &
         list%column_arg, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FILE','OutputFile',&
         'Define an output file for the list',&
         strg_emp,&
         list%file,error)
    if (error) return
    call stdarg%register( &
         'OutputFile',  &
         'Name of the file to store the list', &
         strg_emp,&
         code_arg_mandatory, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'VARIABLE','varname',&
         'Define the name of the SIC variable containing the TOC',&
         strg_emp,&
         list%variable,error)
    if (error) return
    call stdarg%register( &
         'varname',  &
         'Name of the SIC variable to store the TOC', &
         strg_emp,&
         code_arg_mandatory, &
         error)
    if (error) return
  end subroutine cubedag_list_register
  !
  subroutine cubedag_list_parse(list,line,user,error)
    use cubetools_setup_types
    use cubetools_disambiguate
    !---------------------------------------------------------------------
    ! Parsing for DAG\LIST
    !   LIST [CubeID]
    !     [/INDEX DAG|CURRENT]
    !     [/TOC]
    !     [/PAGE]
    !     [/COLUMNS List]
    !     [/FILE OutputFile]
    !     [/VARIABLE VarName]
    !---------------------------------------------------------------------
    class(list_comm_t),       intent(in)    :: list
    character(len=*), target, intent(in)    :: line
    type(list_user_t),        intent(out)   :: user
    logical,                  intent(inout) :: error
    !
    integer(kind=4) :: narg,ncol,iarg
    character(len=argu_l) :: argu,key
    type(cubeid_user_t) :: cubeid
    type(cube_setup_api_t) :: setup
    character(len=*), parameter :: rname='LIST>PARSE'
    !
    ! Command argument. Build the user%find structure to restrict
    ! the search
    narg = list%comm%getnarg()
    if (narg.ge.1) then
      ! Remark 1: we should be able to list several IDs at once, but I
      ! miss a dedicated filter for this (user%ucube can only search
      ! for a scalar pattern).
      ! Remark 2: might have to double-check what happens for
      !  LIST 3   ! List Id #3, should it be in CX or not
      !  LIST -1  ! From the end of CX or IX???
      call cubeadm_cubeid_parse(line,list%comm,cubeid,error)
      if (error) return
      user%ucube = cubeid%cube(1)  ! e.g. 1, 13co10:cube, 13co10*, etc
    else
      ! ZZZ Should have a dedicated method for this
      user%ucube%family = strg_star
      user%ucube%flags = strg_star
      user%ucube%pos = strg_star
      user%ucube%id = strg_star
    endif
    !
    ! /INDEX
    narg = list%index%getnarg()
    if (narg.ge.1) then
       call cubetools_getarg(line,list%index,1,argu,mandatory,error)
       if (error) return
       call cubetools_keywordlist_user2prog(list%index_arg,argu,user%index,key,error)
       if (error) return
    else
       call setup%index%default%get(user%index)
    endif
    !
    ! /FILE
    call list%file%present(line,user%dofile,error)
    if (error) return
    if (user%dofile) then
       call cubetools_getarg(line,list%file,1,user%file,mandatory,error)
       if (error) return
    endif
    !
    ! /TOC
    call list%toc%present(line,user%dotoc,error)
    if (error) return
    if (user%dotoc) then
       user%toc%iopt = list%toc%inum
       user%toc%var = 'TOC'
       call cubetools_getarg(line,list%variable,1,user%toc%var,.not.mandatory,error)
       if (error) return
    else ! /COLUMN, /PAGE
       narg = list%columns%getnarg()
       ncol = size(user%def%ucols)
       if (narg.gt.ncol) then
          call cubedag_message(seve%w,rname,'/COLUMNS list too long, truncated')
       endif
       user%def%ncol = max(1,min(narg,ncol))
       do iarg = 1,user%def%ncol
          user%def%ucols(iarg) = 'DEFAULT'
          call cubetools_getarg(line,list%columns,iarg,user%def%ucols(iarg),.not.mandatory,error)
          if (error) return
       enddo
       call list%page%present(line,user%def%dopage,error)
       if (error) return
    endif
  end subroutine cubedag_list_parse
  !
  subroutine cubedag_list_main(list,user,line,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(list_comm_t), intent(in)    :: list
    type(list_user_t),  intent(in)    :: user
    character(len=*),   intent(in)    :: line
    logical,            intent(inout) :: error
    !
    type(list_prog_t) :: prog
    character(len=*), parameter :: rname='LIST>MAIN'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call user%toprog(line,prog,error)
    if (error) return
    call prog%do(error)
    if (error) return
  end subroutine cubedag_list_main
  !
  subroutine cubedag_list_user_toprog(user,line,prog,error)
    use gkernel_interfaces
    use cubedag_cubeid_find_types
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(list_user_t), intent(in)    :: user
    character(len=*),   intent(in)    :: line
    type(list_prog_t),  intent(out)   :: prog
    logical,            intent(inout) :: error
    !
    type(cubeid_find_t) :: find
    integer(kind=4) :: ier
    character(len=*), parameter :: rname='LIST>USER2PROG'
    !
    call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    call cubedag_cubeid_user2find(list%commarg,user%ucube,find,error)
    if (error)  return
    !
    select case (user%index)
    case (code_index_dag)
      prog%optname = 'DAG'
      call find%filter%ix2optx(prog%optx,error)
      if (error)  return
    case (code_index_current)
      prog%optname = 'Current'
      call find%filter%cx2optx(prog%optx,error)
      if (error)  return
    case default
      call cubedag_message(seve%e,rname,'Default index is not supported')
      error = .true.
      return
    end select
    !
    ! Output to STDOUT or file?
    if (user%dofile) then  ! /FILE
      ier = sic_getlun(prog%olun)
      if (ier.ne.1) then
        call cubedag_message(seve%e,rname,'No logical unit left')
        error = .true.
        return
      endif
      ier = sic_open(prog%olun,user%file,'NEW',.false.)
      if (ier.ne.0) then
        call cubedag_message(seve%e,rname,'Cannot open file '//user%file)
        error = .true.
        call sic_frelun(prog%olun)
        return
      endif
    else
      prog%olun = stdout
    endif
    !
    prog%dotoc = user%dotoc
    if (prog%dotoc) then
      call user%toc%toprog(line,prog%toc,error)
    else
      call user%def%toprog(prog%def,error)
    endif
  end subroutine cubedag_list_user_toprog
  !
  subroutine cubedag_list_do(prog,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    class(list_prog_t), intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: ier
    !
    if (prog%dotoc) then
      call prog%toc%do(prog%optx,prog%olun,error)
    else
      call prog%def%do(prog%optx,prog%optname,prog%olun,error)
    endif
    if (error) continue
    !
    if (prog%olun.ne.stdout) then
      ier = sic_close(prog%olun)
      call sic_frelun(prog%olun)
    endif
  end subroutine
end module cubedag_list
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
