more systematic handling of colored output

isatty for Fortran needs to translate the units/file descriptors
This commit is contained in:
Martin Diehl 2023-12-10 06:52:06 +01:00
parent f3e7f51bb4
commit 4320e9847d
No known key found for this signature in database
GPG Key ID: 1FD50837275A0A9B
3 changed files with 37 additions and 23 deletions

View File

@ -94,6 +94,10 @@ int stderr_isatty_c(){
return isatty(STDERR_FILENO);
}
int stdin_isatty_c(){
return isatty(STDIN_FILENO);
}
#ifdef FYAML
void to_flow_c(char **flow, long* length_flow, const char *mixed){

View File

@ -438,25 +438,23 @@ end function IO_strAsBool
!--------------------------------------------------------------------------------------------------
!> @brief Set foreground and/or background color.
!> @details Only active if unit is a TTY. Does nothing for MSC.Marc or when writing to log file.
!> @brief Return string to set foreground and/or background color.
!> @details Only active if unit is a TTY. Does nothing for MSC.Marc. No color disables formatting.
!> @details https://stackoverflow.com/questions/4842424
!--------------------------------------------------------------------------------------------------
function IO_color(fg,bg,unit)
character(len=:), allocatable :: IO_color
integer, intent(in), dimension(3), optional :: fg, bg
integer, intent(in), dimension(3), optional :: &
fg, & !< foreground color (8 bit RGB)
bg !< background color (8 bit RGB)
integer, intent(in), optional :: unit !< output unit (default STDOUT)
integer :: unit_
IO_color = ''
#if !(defined(MARC4DAMASK) || defined(LOGFILE))
unit_ = misc_optional(unit,IO_STDOUT)
if (unit_ == IO_STDOUT .and. .not. STDOUT_isatty()) return
if (unit_ == IO_STDERR .and. .not. STDERR_isatty()) return
#ifndef MARC4DAMASK
if (.not. isatty(misc_optional(unit,IO_STDOUT))) return
if (present(fg)) &
IO_color = IO_color//achar(27)//'[38;2;'//IO_intAsStr(fg(1))//';' &

View File

@ -21,8 +21,7 @@ module system_routines
signalint_C, &
signalusr1_C, &
signalusr2_C, &
STDOUT_isatty, &
STDERR_isatty, &
isatty, &
f_c_string, &
free_C
@ -107,6 +106,14 @@ module system_routines
integer(C_INT) :: stderr_isatty_C
end function stderr_isatty_C
function stdin_isatty_C() bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT
implicit none(type,external)
integer(C_INT) :: stdin_isatty_C
end function stdin_isatty_C
end interface
contains
@ -246,23 +253,28 @@ end function f_c_string
!--------------------------------------------------------------------------------------------------
!> @brief
!> @brief Test whether a file descriptor refers to a terminal.
!> @detail A terminal is neither a file nor a redirected STDOUT/STDERR/STDIN.
!--------------------------------------------------------------------------------------------------
logical function STDOUT_isatty()
logical function isatty(unit)
STDOUT_isatty = merge(.true.,.false.,stdout_isatty_C()==1)
end function STDOUT_isatty
integer, intent(in) :: unit
!--------------------------------------------------------------------------------------------------
!> @brief
!--------------------------------------------------------------------------------------------------
logical function STDERR_isatty()
select case(unit)
#ifndef LOGFILE
case (OUTPUT_UNIT)
isatty = stdout_isatty_C()==1
case (ERROR_UNIT)
isatty = stderr_isatty_C()==1
#endif
case (INPUT_UNIT)
isatty = stdin_isatty_C()==1
case default
isatty = .false.
end select
STDERR_isatty = merge(.true.,.false.,stderr_isatty_C()==1)
end function STDERR_isatty
end function isatty
!--------------------------------------------------------------------------------------------------