fdoc

subroutinehighlight_fortran

subroutine highlight_fortran(code, out, line_anchors)

Write code as highlighted HTML. With line_anchors, each line starts with an anchor ln-N.

Arguments

NameTypeIntentAttributesDescription
codecharacter(len=*)in

the source

outtype(buffer_t)inout

the HTML

line_anchorslogicalin

true to number the lines

Calls

Source

Show the code
subroutine highlight_fortran(code, out, line_anchors)
    character(len=*), intent(in) :: code    !! the source
    type(buffer_t), intent(inout) :: out    !! the HTML
    logical, intent(in) :: line_anchors     !! true to number the lines
    type(token_list_t) :: tokens
    character(len=:), allocatable :: class
    integer :: k, line

    call tokenize(code, tokens)
    line = 1
    if (line_anchors) call line_start(out, line)
    do k = 1, tokens%n
        associate (t => tokens%tok(k))
            class = ''
            select case (t%kind)
            case (TK_COMMENT)
                class = 'c'
                if (t%last > t%first) then
                    if (scan(code(t%first + 1:t%first + 1), '!<>|*') == 1) class = 'd'
                end if
            case (TK_PREPROC)
                class = 'p'
            case (TK_STRING)
                class = 's'
            case (TK_INT, TK_REAL, TK_BOZ)
                class = 'n'
            case (TK_DOTOP)
                class = 'k'
            case (TK_NAME)
                if (is_intrinsic(lowercase(code(t%first:t%last)))) class = 'k'
            end select
            if (len(class) > 0) call add(out, '<span class="'//class//'">')
            call write_text(code(t%first:t%last))
            if (len(class) > 0) call add(out, '</span>')
        end associate
    end do

contains

    !> Write token text, starting a new numbered line at each line feed.
    subroutine write_text(text)
        character(len=*), intent(in) :: text    !! the text
        integer :: start, at

        if (.not. line_anchors) then
            call html_escape(text, out, .false.)
            return
        end if
        start = 1
        do
            at = index(text(start:), achar(10))
            if (at == 0) exit
            call html_escape(text(start:start + at - 1), out, .false.)
            start = start + at
            line = line + 1
            call line_start(out, line)
        end do
        call html_escape(text(start:), out, .false.)
    end subroutine write_text

end subroutine highlight_fortran

Graphs

Calls

Called by