!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine sicset_message(line,error)
  use sic_dependencies_interfaces
  use gbl_message
  use gpack_def
  use sic_interfaces, except_this=>sicset_message
  !---------------------------------------------------------------------
  ! @ private
  !    Support routine for command SIC\SIC MESSAGE. Should only be
  ! called by SICSET subroutine, which supports the SIC\SIC command.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Error flag
  ! Local
  !
  if (sic_present(1,0)) then  ! /COLOR
    call sicset_message_colors(line,error)
    if (error)  return
  else
    call sicset_message_rules(line,error)
    if (error)  return
  endif
  !
end subroutine sicset_message
!
subroutine sicset_message_rules(line,error)
  use sic_dependencies_interfaces
  use gbl_message
  use gpack_def
  use sic_interfaces, except_this=>sicset_message_rules
  !---------------------------------------------------------------------
  ! @ private
  ! Syntax may be:
  !    SIC MESSAGE
  !       (nothing done, just print active filters)
  !    SIC MESSAGE PackName [ [S|L|A][-|=|+]F|E|W|R|I|D|T ] [...]
  !       (update and print considered package(s) filters)
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Error flag
  ! Local
  character(len=80) :: arg
  character(len=80) :: package
  integer :: narg,iarg,al,pack_id,sev
  logical :: newone,found
  character(len=*), parameter :: rname = 'SIC MESSAGE'
  !
  sev = seve%r
  narg = sic_narg(0)
  !
  ! Print current values if no argument: loop on all active packages
  if (narg.eq.1) then
    call gmessage_print_active(sev,error)
    return
  endif
  !
  iarg = 2
  error  = .false.
  newone = .true.    ! Next arg must be a new package?
  !
  do while (iarg.le.narg)
    !
    call sic_ch(line,0,iarg,arg,al,.true.,error) ! Get next arg
    if (error) return
    !
    ! Try to resolve package name
    call gpack_resolve(arg,found,error)
    if (error) return
    !
    ! Found a new package or *:
    if (found .or. arg.eq.'*') then
      !
      ! Flush previous package
      if (iarg .ne. 2) then
         if (package.eq.'*') then
           call gmessage_print_all(sev,error)
         else
           call gmessage_print_id(pack_id,sev,error)
         endif
         if (error) return
         sev = seve%r
      endif
      !
      ! Set new package
      package = arg
      if (package.ne.'*')  pack_id = gpack_get_id(package,.true.,error)
      newone  = .false.
    !
    ! Expected a package, but it is not found:
    elseif (newone .and. .not.found) then
      !
      call sic_message(seve%e,rname,'Unknown package '''//arg(1:al)//'''')
      error = .true.
      return
    !
    ! Special case for 'global' rules:
    elseif (package.eq.gpack_global_name) then
      !
      if (arg.eq.'on') then
        call sic_message(seve%r,rname,"Turning ON global filtering rules")
        call gmessage_use_gbl_rules(.true.)
      elseif (arg(1:2).eq.'of') then
        call sic_message(seve%r,rname,"Turning OFF global filtering rules")
        call gmessage_use_gbl_rules(.false.)
      else           ! Must be a 'global' rule
        call gmessage_parse_and_set(pack_id,arg,error)
        sev = seve%d
        if (error) return
      endif
      !
    ! Else must be a rule:
    else
      !
      if (package.eq.'*') then
        call gmessage_parse_and_set_all(arg,error)
      else
        call gmessage_parse_and_set(pack_id,arg,error)
      endif
      if (error) return
      sev = seve%d
      newone = .true.
      !
    endif
    !
    iarg = iarg+1
  enddo
  !
  ! Print pending package:
  if (package.eq.'*') then
    call gmessage_print_all(sev,error)
  else
    call gmessage_print_id(pack_id,sev,error)
  endif
  if (error) return
  !
end subroutine sicset_message_rules
!
subroutine sicset_message_colors(line,error)
  use sic_dependencies_interfaces
  use gbl_message
  use sic_interfaces, except_this=>sicset_message_colors
  !---------------------------------------------------------------------
  ! @ private
  ! Syntax may be:
  !    SIC MESSAGE /COLOR
  !       (nothing done, just print active colors)
  !    SIC MESSAGE /COLOR ON|OFF
  !       (turn on/off the message coloring)
  !    SIC MESSAGE /COLOR E=RED W=ORANGE ...
  !       (update relevant message colors)
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname = 'SIC MESSAGE'
  integer(kind=4), parameter :: optcolor=1
  integer(kind=4) :: iarg,narg,nc
  character(len=32) :: argum
  !
  narg = sic_narg(optcolor)
  !
  ! Print current values if no argument: loop on all active packages
  if (narg.eq.0) then
    call gmessage_print_colors(error)
    return
  endif
  !
  do iarg=1,narg
    call sic_ke(line,optcolor,iarg,argum,nc,.true.,error)
    if (error)  return
    if (argum.eq.'ON') then
      call gmessage_colors_swap(.true.)
    elseif (argum.eq.'OFF') then
      call gmessage_colors_swap(.false.)
    else
      call gmessage_colors_parse(argum,error)
      if (error)  return
    endif
  enddo
  !
end subroutine sicset_message_colors
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine sic_message_command(line,error)
  use sic_dependencies_interfaces
  use gbl_message
  use gpack_def
  use sic_interfaces, except_this=>sic_message_command
  !---------------------------------------------------------------------
  ! @ private
  ! SIC Internal routine
  !    Support routine for command SIC\MESSAGE. Syntax is:
  !    MESSAGE F|E|W|R|I|D|T  ProcName  "Message"
  !    MESSAGE F|E|W|R|I|D|T  ProcName  Arg1 Arg2 ... ArgN
  ! 1  [/FORMAT <fmt1> <fmt2> ... <fmtN>]
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  logical,          intent(out) :: error  ! Error flag
  ! Local
  character(len=*), parameter :: rname = 'MESSAGE'
  character(len=1) :: lsev
  character(len=32) :: proc            ! Length should be a parameter
  character(len=message_length) :: chain,message
  integer :: larg,scode,narg,iarg,ml,lchain
  logical :: do_format
  !
  narg = sic_narg(0)
  if (narg.lt.3) then
    call sic_message(seve%e,rname,'Command MESSAGE needs at least 3 arguments')
    error = .true.
    return
  endif
  !
  ! Retrieve kind letter and translate it
  call sic_ch (line,0,1,lsev,larg,.true.,error)
  if (error) return
  call gmessage_translate(lsev,scode,error)
  if (error) return
  !
  ! Retrieve procedure name
  call sic_ch (line,0,2,proc,larg,.true.,error)
  if (error) return
  call sic_upper(proc)
  !
  ! Retrieve message
  ml = 1
  do_format = sic_present(1,0)
  do iarg=3,narg
    if (do_format) then
      call say_format_arg(line,iarg,iarg-2,0,chain,lchain,error)
      if (error) return
    else
      call sic_ch (line,0,iarg,chain,lchain,.true.,error)
      if (error) return
    endif
    message(ml:) = chain(:lchain)
    ml = ml+lchain+1
  enddo
  !
  call gmessage_write(gmaster_get_id(),scode,proc,message)
  !
end subroutine sic_message_command
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
