subroutine gtl_clear(line,error)
  use gtv_buffers
  use gtv_graphic
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_clear
  use gtv_protocol
  use gtv_tree
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command CLEAR
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CLEAR'
  integer, parameter :: nvocab=8
  character(len=12) :: vocab(nvocab),to_check,comm
  integer :: ncom,nc,sever,usernum,cnum
  character(len=gtvpath_length) :: name
  !
  data vocab /'ALPHA','DIRECTORY','GRAPHIC','PLOT','SEGMENT','TREE',  &
    'WINDOW','WHOLE'/
  !
  if (sic_present(0,1)) then
    call sic_ke (line,0,1,to_check,nc,.true.,error)
    if (error) return
    call sic_upper(to_check)
    if (to_check.eq.'ALL') then
      ! Non-standard detection of 'ALL' as long as CLEAR ALPHA (often
      ! invoked with "CL AL" in procedures) exists, to avoid ambiguities.
      comm = 'ALL'
    else
      call sic_ambigs(rname,to_check,comm,ncom,vocab,nvocab,error)
      if (error)  return
    endif
  else
    comm = 'ALL'  ! Default is CLEAR ALL
  endif
  !
  if (strict2011) then
    sever = seve%e
  else
    sever = seve%w
  endif
  !
  select case (comm)
  case ('ALL')  ! Clear the content of all top directories
    call gtv_clear_all(error)
    call gtview('Update')
    !
  case ('ALPHA')  ! Lower alpha window
    ! Obsolete since 23-sep-2010
    call gtv_message(sever,rname,'CLEAR ALPHA is obsolete')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    call gtv_clear_alpha(cw_output)
    !
  case('TREE')  ! Clear "current tree" e.g. GREG and its subdirectories
    ! Obsolete since 11-oct-2010
    call gtv_message(sever,rname,'CLEAR TREE is obsolete')
    call gtv_message(sever,rname,'Use CLEAR DIRECTORY [Name] instead')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    name = ' '
    call sic_ch(line,0,2,name,nc,.false.,error)
    if (error) return
    call gtv_clear_tree(name,error)
    if (error)  return
    call gtview('Update')
    return
    !
  case ('WHOLE')  ! All plots
    ! Obsolete since 11-oct-2010
    call gtv_message(sever,rname,'CLEAR WHOLE is obsolete')
    call gtv_message(sever,rname,'Use DESTROY ALL instead')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    call gtv_destroy_all(error)
    return
    !
  case ('DIRECTORY')  ! Clear directory
    call gtl_clear_directory(line,error)
    if (error)  return
    !
  case ('GRAPHIC')  ! Raise alpha window
    ! Obsolete since 23-sep-2010
    call gtv_message(sever,rname,'CLEAR GRAPHIC is obsolete')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    call gtv_clear_graphic(cw_output)
    !
  case ('PLOT')  ! Clear whole plot
    call gtv_message(sever,rname,'CLEAR PLOT is obsolete. If you want to (see HELP for details):')
    call gtv_message(sever,rname,'- clear the content of all the windows, use CLEAR [ALL]')
    call gtv_message(sever,rname,'- destroy all the directories and windows, use DESTROY ALL')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    call gtv_destroy_all(error)
    return
    !
  case ('SEGMENT')  ! Clear segment
    if (sic_present(0,2)) then
      ! Clear named segment
      call gtl_clear_segment(line,error)
    else
      ! Clear last segment
      call gtdls  ! Write-protected
      call gtview('Update')
    endif
    !
  case ('WINDOW')
    call gtv_message(sever,rname,'CLEAR WINDOW is obsolete. If you want to (see HELP for details):')
    call gtv_message(sever,rname,'- destroy a window, use DESTROY WINDOW [DirName [WinNum]]')
    call gtv_message(sever,rname,'- clear the content of a window, use CLEAR DIRECTORY [DirName]')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    ! Clear named window
    !
    call gtv_open_segments_for_writing_from_main()
    !
    if (sic_present(0,2)) then
      call sic_i4(line,0,2,usernum,.true.,error)
      cnum = get_window_cnum(cw_directory,usernum,error)
      call win_destroy_one(cw_directory,cnum,error)
    else
      ! Current window
      call win_destroy_one(cw_directory,cw_directory%x%curwin,error)
    endif
    !
    call gtv_close_segments_for_writing_from_main()
    !
  case default
    call gtv_message(seve%e,rname,''''//trim(comm)//''' not yet implemented.')
    error = .true.
    return
  end select
  !
end subroutine gtl_clear
!
subroutine gtl_clear_segment(line,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_clear_segment
  use gtv_buffers
  !---------------------------------------------------------------------
  ! @ private
  !  Cleanly destroy named segment(s) from the GTV tree, reading name
  ! from the command line.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line  ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=gtvpath_length) :: argum
  integer :: nc
  !
  ! Get segment name
  call sic_ch(line,0,2,argum,nc,.true.,error)
  if (error) return
  !
  call gt_clear_segment(argum,.true.,error)
  if (error)  return
  !
end subroutine gtl_clear_segment
!
subroutine gt_clear_segment(argum_in,present,error)
  use gtv_buffers
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gt_clear_segment
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !  Destroy the input segment(s) given its(their) name. They can have
  ! an absolute path. Argument 'present' indicates if the segment(s)
  ! must exist i.e. if it should be an error if it(they) is(are) not
  ! found.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: argum_in  ! Segment name
  logical,          intent(in)    :: present   ! Must the segment exist?
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CLEAR'
  character(len=gtvpath_length) :: argum
  integer :: ia,la,iseg,isegstep,iseg1,iseg2
  logical :: isdir,found,done
  type(gt_directory), pointer :: workdir,father
  type(gt_segment), pointer :: segm
  !
  argum = argum_in
  call sic_upper(argum)
  !
  call decode_chemin(argum,cw_directory,workdir,isdir,segm,found)
  if (isdir) then
    call gtv_message(seve%e,rname,  &
      'Input segment is a directory, use CLEAR DIRECTORY [Name] instead')
    error = .true.
    return
  endif
  !
  ! Found or not found: assume it represents a segment. Parse wildcards,
  ! range and so on
  call gtl_segment_parse(argum,iseg1,iseg2,error)
  if (error) return
  la = len_trim(argum)
  ia = index(argum,':')
  isegstep=1
  if (iseg1.ge.iseg2) isegstep=-1
  !
  done = .false.
  !
  do iseg=iseg1,iseg2,isegstep
    if (iseg.ne.0) then
      write(argum(ia+1:),'(I6)') iseg
      la = ia+6
      call sic_black(argum,la)
      call decode_chemin(argum,cw_directory,workdir,isdir,segm,found)
    else
      found = .false.
    endif
    if (found.and..not.isdir) then
      father => segm%father
      if (associated(segm,father%leaf_last)) then
        ! We will destroy the last segment in the directory. We can
        ! decrease its number of segment used.
        father%segn = father%segn - 1
      endif
      !
      call clear_segment_elem(segm,error)
      if (error)  exit  ! iseg
      done = .true.
    endif
  enddo
  !
  if (error) then
    return
    !
  elseif (done) then
    call gtview('Update')
    !
  elseif (present) then
    call gtv_message(seve%e,rname,'No such segment '//argum_in)
    error = .true.
    return
  endif
  !
end subroutine gt_clear_segment
!
subroutine clear_segment_elem(segm,error)
  use gtv_interfaces, except_this=>clear_segment_elem
  use gtv_buffers
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Cleanly clear the input segment, taking care of the surrounding
  ! chain and pointers in the GTV tree.
  ! ---
  !   Threads status: thread safe
  !---------------------------------------------------------------------
  type(gt_segment), pointer :: segm   ! Segment to clear
  logical,    intent(inout) :: error  ! Logical error flag
  ! Local
  type(gt_segment), pointer :: othersegm,previous
  type(gt_directory), pointer :: father
  !
  if (associated(segm,co_segment)) then
    co_segment => null()
    co_segment_data => null()
  endif
  !
  ! Search for the previous segment in the linked list
  father => segm%father
  previous => null()
  othersegm => father%leaf_first
  do while (.not.associated(othersegm,segm))
    previous => othersegm
    othersegm => othersegm%nextseg
  enddo
  !
  call gtv_open_segments_for_writing_from_main()
  !
  ! Update the chain of segments
  if (.not.associated(previous)) then
    ! Segment to destroy is the first in the directory
    father%leaf_first => segm%nextseg  ! ... which can be null()
  else
    previous%nextseg => segm%nextseg ! ... which can be null()
  endif
  !
  ! Update the pointers of the parent directory
  if (associated(father%leaf_last,segm)) then
    ! Segment to destroy is the last in the directory
    father%leaf_last => previous ! ... which can be null()
  endif
  !
  ! Update the limits of the parent directory
  call gtv_limits(father,error)
  !
  call gtv_close_segments_for_writing_from_main()
  !
  ! Free the segment: put it in the stack for later deletion
  segm%nextseg => null()  ! Do not delete its brother
  if (associated(segm))  &
    call x_destroy_segment(segm)  ! will call gtv_delsegments(segm)
  !
end subroutine clear_segment_elem
!
subroutine gtv_clear_all(error)
  use gtv_buffers
  use gtv_interfaces, except_this=>gtv_clear_all
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command:
  !    CLEAR ALL
  ! Clean (i.e. destroy the content of) all the top directories,
  ! leaving them alive, with all their windows.
  !---------------------------------------------------------------------
  logical, intent(inout) :: error  ! Logical error flag
  ! Local
  logical :: keepall
  type(gt_directory), pointer :: brother
  !
  keepall = .true.  ! Keep all window of the cleared directory
  brother => root%son_first
  do while (associated(brother))
    call gt_clear_directory(brother,keepall,error)
    if (error)  return
    !
    brother => brother%brother
  enddo
  !
end subroutine gtv_clear_all
!
subroutine gtv_clear_tree(name_in,error)
  use gildas_def
  use gtv_buffers
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtv_clear_tree
  use gtv_protocol
  use gtv_tree
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Erases the current tree only. If the current tree is alone,
  ! erases the whole plot, which saves space for the images...
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name_in  ! Tree name
  logical,          intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CLEAR TREE'
  character(len=64) :: dirname
  logical :: isdir,found,keepall
  type(gt_directory), pointer :: workdir
  type(gt_segment), pointer :: segm
  integer :: win_num
  !
  if (name_in.eq.' ') then
    workdir => cw_directory
    !
  else
    ! Get the directory
    dirname = name_in
    call sic_upper(dirname)
    call decode_chemin(dirname,cw_directory,workdir,isdir,segm,found)
    if (.not.found) then
      call gtv_message(seve%e,rname,'No such directory '//dirname)
      error = .true.
      return
    endif
    if (.not.isdir) then
      call gtv_message(seve%e,rname,  &
        'Input segment is not a directory, use CLEAR SEGMENT [Name] instead')
      error = .true.
      return
    endif
    ! Protect root
    if (associated(workdir,root)) then
      call gtv_message(seve%e,rname,'Can not delete root directory <')
      error = .true.
      return
    endif
  endif
  !
  ! We will work from the ancestor (i.e. the whole tree)
  workdir => workdir%ancestor
  !
  ! Implicitely move to the ancestor
  win_num = 0
  call gtv_open_segments_for_writing_from_main()
  call cd_by_adr(workdir,win_num,error)
  call gtv_close_segments_for_writing_from_main()
  if (error)  return
  !
  keepall = .false.
  call gt_clear_directory(workdir,keepall,error)  ! Thread-safe
  if (error)  return
  !
end subroutine gtv_clear_tree
!
subroutine gtl_clear_directory(line,error)
  use gtv_buffers
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_clear_directory
  use gtv_tree
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command CLEAR DIRECTORY [Name]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=gtvpath_length) :: dirname
  integer(kind=4) :: nc
  logical :: keepall
  !
  if (sic_present(0,2)) then
    ! Clear the named directory
    call sic_ch(line,0,2,dirname,nc,.true.,error)
    if (error) return
    call gtv_clear_directory(dirname,error)
    if (error)  return
  else
    ! Clear current working directory
    keepall = .true.  ! Keep all windows
    call gt_clear_directory(cw_directory,keepall,error)  ! Thread-safe
    if (error)  return
  endif
  !
end subroutine gtl_clear_directory
!
subroutine gtv_clear_directory(name,error)
  use gbl_message
  use gtv_interfaces, except_this=>gtv_clear_directory
  use gtv_buffers
  use gtv_types
  !---------------------------------------------------------------------
  ! @ public
  ! Support for CLEAR DIRECTORY, using a name as input argument
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: name   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='CLEAR'
  character(len=gtvpath_length) :: uname
  logical :: isdir,found,keepall
  type(gt_directory), pointer :: workdir
  type(gt_segment), pointer :: segm
  !
  ! Get the directory
  uname = name
  call sic_upper(uname)
  call decode_chemin(uname,cw_directory,workdir,isdir,segm,found)
  if (.not.found) then
    call gtv_message(seve%e,rname,'No such directory '//name)
    error = .true.
    return
  endif
  if (.not.isdir) then
    call gtv_message(seve%e,rname,  &
      'Input segment is not a directory, use CLEAR SEGMENT [Name] instead')
    error = .true.
    return
  endif
  !
  keepall = .true.  ! Keep all windows
  call gt_clear_directory(workdir,keepall,error)  ! Thread-safe
  if (error)  return
  !
end subroutine gtv_clear_directory
!
subroutine gt_clear_directory(dir,keepall,error)
  use gbl_message
  use gildas_def
  use gtv_buffers
  use gtv_interfaces, except_this=>gt_clear_directory
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Cleanly destroy the content of the input directory, taking care of
  ! the surrounding elements in the GTV tree. The top directory and its
  ! first window is kept.
  !---------------------------------------------------------------------
  type(gt_directory), pointer :: dir      ! Directory to destroy
  logical,      intent(in)    :: keepall  ! Keep all the windows, or only one?
  logical,      intent(inout) :: error    ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CLEAR'
  type(gt_directory), pointer :: son_first,father,nextdir
  type(gt_segment), pointer :: leaf_first
  integer(kind=address_length) :: genv
  !
  ! 1) Check if we do not attempt to clear the root <
  if (associated(dir,root)) then
    call gtv_message(seve%e,rname,'Can not clear root directory')
    error = .true.
    return
  endif
  !
  call gtv_open_segments_for_writing_from_main()
  !
  ! 2) Check if the current working directory has to be destroyed.
  father => cw_directory%father
  do while (associated(father))
    if (associated(father,dir)) then
      ! One of the fathers is the directory to be *cleaned*, i.e. we will
      ! *destroy* the current directory. Switch to the directory to be
      ! cleaned.
      call cd_by_adr(dir,dir%x%curwin,error)
      if (error)  return
      exit
    endif
    father => father%father
  enddo
  !
  ! 3) Which windows keep at first level?
  if (.not.keepall) then
    ! Delete all but 1 window
    call win_destroy_almost(dir,genv,error)
    if (error)  return
    if (genv.ne.0) then
      ! There was actually a window to save
      dir%x%genv_array = c_new_genv_array(mwindows)
      dir%x%genv = genv
      call c_set_win_genv(dir%x%genv_array,0,dir%x%genv)
    endif
  endif
  !
  ! 4) Destroy the windows of all the subdirectories (because these
  !    directories will be destroyed)
  nextdir => dir%son_first
  do while (associated(nextdir))
    call win_destroy_all_recursive(nextdir,error)
    if (error)  return
    nextdir => nextdir%brother
  enddo
  !
  ! 5) Update the pointers in the GTV tree, i.e. forget about the son
  !    directories and leaves
  son_first => dir%son_first  ! Keep track before forgetting it
  dir%son_first => null()
  dir%son_last => null()
  leaf_first => dir%leaf_first  ! Keep track before forgetting it
  dir%leaf_first => null()
  dir%leaf_last => null()
  dir%segn = 0
  !
  ! 6) Update the limits of the parents directory
  call gtv_limits(dir,error)
  !
  call gtv_close_segments_for_writing_from_main()
  !
  ! 7) Effectively destroy the list of son directories. This can be done
  !  out of the threads protection since nobody knows that the input
  !  directory had children one day.
  if (associated(son_first))  &
    call x_destroy_directory(son_first)  ! will call gtv_deldirectories(son_first)
  !
  ! 8) Effectively destroy the list of segments. This can be done out of the
  !  threads protection since nobody knows that the input directory had
  ! segments one day.
  if (associated(leaf_first))  &
    call x_destroy_segment(leaf_first)  ! will call gtv_delsegments(leaf_first)
  !
  ! 9) Update the plot. Only needed from the ancestor cleared directory
  !  (no need to refresh all directories)
  call gtview_update(dir%ancestor,error)
  !
end subroutine gt_clear_directory
!
subroutine exit_clear
  use gtv_interfaces, except_this=>exit_clear
  use gtv_bitmap
  use gtv_buffers
  use gtv_plot
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ public
  !  This function exists solely to prevent all the wild machinations
  ! that 'gtv_destroy_all' does in recreating the x graphical
  ! environment, when all you are really trying to do is exit the
  ! program so you can go home. It is therefore only called by program
  ! GreG before calling GTCLOS
  !---------------------------------------------------------------------
  ! Local
  logical :: error
  !
  error = .false.
  !
  ! Flush the stack (it contains the tree destruction, so call it
  ! whatever the device is).
  call x_flush(1)
  !
  if (cw_device%protocol.eq.p_x) then
    ! Clear all the directories (and the allocated data in each:
    ! polylines, images, etc). Put it in the stack to ensure that all the
    ! remaining drawing instructions have been performed.
    if (associated(root))  &
      call x_destroy_directory(root)  ! will call gtv_deldirectories(root)
  else
    call gtv_destroy_all(error)
  endif
  !
  ! Free memory allocated in global variables
  call gt_lut_dealloc(gbl_pen,error)
  call gt_lut_dealloc(gbl_colormap,error)
  !
  if (allocated(eqlev))  deallocate(eqlev,eqbin)
  !
end subroutine exit_clear
!
subroutine gti_clear(output)
  use gtv_interfaces, except_this=>gti_clear
  use gtv_types
  use gtv_tree
  use gtv_buffers
  use gtv_graphic
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  ! - Erase the graphic screen only
  ! - Erase all bit planes
  ! - Reset most device features, and should normally be used to be sure
  !   that the initialisation is correct.
  ! - Rewinds the viewing pointers
  !---------------------------------------------------------------------
  type(gt_display) :: output  ! Output instance
  !
  if (.not.awake .or. error_condition) return
  !
  ! Return if no output device
  if (output%dev%protocol.eq.p_null) then
    return
    !
  elseif (output%dev%protocol.eq.p_x) then
    ! X protocol
    if (output%x%graph_env.ne.0)  call x_clear(output%x%graph_env)
    !
  endif
  !
end subroutine gti_clear
