subroutinebuild_graphs

subroutine build_graphs(p, s, members, list_codes, set, stat, errmsg)
    type(project_t), intent(in) :: p                    !! the project
    type(settings_t), intent(in) :: s                   !! the settings
    integer, intent(in) :: members(:)                   !! the entities that have pages
    integer, intent(in) :: list_codes(4)                !! the list pages of files, modules, procedures, types
    type(graph_set_t), intent(out) :: set               !! the graphs
    integer, intent(out) :: stat                        !! nonzero on failure
    character(len=:), allocatable, intent(out) :: errmsg !! what is wrong
    type(adjacency_t) :: relations(NUM_RELATIONS)
    type(graph_job_t), allocatable :: jobs(:)
    type(string_t), allocatable :: drawings(:), descriptions(:)
    logical, allocatable :: failed(:)
    integer, allocatable :: roots(:)
    character(len=:), allocatable :: directory
    character(len=32) :: tag
    logical :: any_wanted, keep
    integer :: k, m, n, depth, nodes, status, count_jobs

    stat = 0
    allocate (set%graphs(0))
    any_wanted = s%graph
    do k = 1, p%list%n
        if (.not. allocated(p%list%box(k)%e%meta)) cycle
        if (any([(p%list%box(k)%e%meta(n)%key == 'graph', n=1, size(p%list%box(k)%e%meta))])) any_wanted = .true.
    end do
    if (.not. any_wanted) return

    call progress_start('Finding dependencies', size(members))
    call build_relations(p, relations)
    allocate (jobs(0))
    count_jobs = 0
    do k = 1, size(members)
        call progress_tick()
        associate (id => members(k))
            if (.not. graphs_wanted(p, s, id, depth, nodes)) cycle
            select case (p%list%box(id)%e%kind)
            case (E_MODULE, E_SUBMODULE)
                call one(id, REL_USES, .true., 'Uses', RANK_RL)
                call one(id, REL_USES, .false., 'Used by', RANK_RL)
            case (E_TYPE)
                call one(id, REL_INHERITS, .true., 'Inherits', RANK_RL)
                call one(id, REL_INHERITS, .false., 'Inherited by', RANK_RL)
            case (E_SUBROUTINE, E_FUNCTION, E_MODPROC, E_INTERFACE)
                call one(id, REL_CALLS, .true., 'Calls', RANK_LR)
                call one(id, REL_CALLS, .false., 'Called by', RANK_RL)
            case (E_PROGRAM)
                call one(id, REL_CALLS, .true., 'Calls', RANK_LR)
                call one(id, REL_USES, .true., 'Uses', RANK_RL)
            case (E_BLOCKDATA)
                call one(id, REL_USES, .true., 'Uses', RANK_RL)
            case (E_FILE)
                call one(id, REL_FILES, .true., 'Files this one depends on', RANK_RL)
                call one(id, REL_FILES, .false., 'Files that depend on this one', RANK_RL)
            end select
        end associate
    end do
    if (s%graph) then
        call project_graph([E_MODULE, E_SUBMODULE], REL_USES, list_codes(2), 'Module graph')
        call project_graph([E_TYPE], REL_INHERITS, list_codes(4), 'Type graph')
        call project_graph([E_SUBROUTINE, E_FUNCTION, E_PROGRAM, E_INTERFACE], REL_CALLS, list_codes(3), 'Call graph')
        call project_graph([E_FILE], REL_FILES, list_codes(1), 'File graph')
    end if
    call progress_finish()

    n = count_jobs
    if (n == 0) return
    keep = allocated(s%graph_dir)
    allocate (drawings(n), descriptions(n), failed(n))
    call draw_graphs(p, s, relations, jobs(1:n), keep, drawings, descriptions, failed, max(1, s%parallel))

    if (keep) then
        call unique_tag(tag)
        ! a directory of this run's own, as the names of the files inside are the same in every run
        directory = s%graph_dir//'/'//trim(tag)
        call make_directory(directory, status)
    end if
    deallocate (set%graphs)
    allocate (set%graphs(count([(allocated(drawings(k)%s), k=1, n)])))
    m = 0
    do k = 1, n
        if (failed(k)) call warn('no layout for a graph of '//jobs(k)%title)
        if (.not. allocated(drawings(k)%s)) cycle
        m = m + 1
        if (keep) then
            call write_whole_file(directory//'/g'//trim(int_text(m))//'.gv', descriptions(k)%s, stat, errmsg)
            if (stat /= 0) return
            call write_whole_file(directory//'/g'//trim(int_text(m))//'.gv.svg', drawings(k)%s, stat, errmsg)
            if (stat /= 0) return
        end if
        call move_alloc(drawings(k)%s, set%graphs(m)%svg)
        call move_alloc(jobs(k)%title, set%graphs(m)%title)
        set%graphs(m)%owner = jobs(k)%owner
        set%graphs(m)%list_page = jobs(k)%list_page
    end do

contains

    !> Add a graph of the page of `id`.
    subroutine one(id, relation, forward, title, direction)
        integer, intent(in) :: id                   !! the entity
        integer, intent(in) :: relation             !! the relation
        logical, intent(in) :: forward              !! true to follow edges forward
        character(len=*), intent(in) :: title       !! the heading
        integer, intent(in) :: direction            !! which way ranks go

        call add_job([id], relation, forward, depth, nodes, direction, title, id, 0)
    end subroutine one

    !> Add the graph of a whole relation to a list page.
    subroutine project_graph(kinds, relation, page, title)
        integer, intent(in) :: kinds(:)         !! the kinds of entity
        integer, intent(in) :: relation         !! the relation
        integer, intent(in) :: page             !! the list page
        character(len=*), intent(in) :: title   !! the heading
        integer :: j

        allocate (roots(0))
        do j = 1, size(members)
            if (p%list%box(members(j))%e%iface == IFACE_ABSTRACT) cycle
            if (any(p%list%box(members(j))%e%kind == kinds)) call push_int(roots, members(j))
        end do
        if (size(roots) > s%graph_project_maxnodes) then
            call warn(title//' left out: it would have more than '//trim(int_text(s%graph_project_maxnodes))// &
                      ' nodes (see graph_project_maxnodes)')
        else if (size(roots) > 1) then
            call add_job(roots, relation, .true., 1, huge(1), RANK_RL, title, 0, page)
        end if
        deallocate (roots)
    end subroutine project_graph

    !> Add a graph to the list.
    subroutine add_job(start, relation, forward, max_depth, max_nodes, direction, title, owner, page)
        integer, intent(in) :: start(:)         !! where to start
        integer, intent(in) :: relation         !! the relation
        logical, intent(in) :: forward          !! true to follow edges forward
        integer, intent(in) :: max_depth        !! how many hops to follow
        integer, intent(in) :: max_nodes        !! how many nodes to allow
        integer, intent(in) :: direction        !! which way ranks go
        character(len=*), intent(in) :: title   !! its heading
        integer, intent(in) :: owner            !! the entity whose page shows it, or 0
        integer, intent(in) :: page             !! the list page that shows it, or 0
        type(graph_job_t), allocatable :: grown(:)
        integer :: j

        if (count_jobs == size(jobs)) then
            allocate (grown(max(64, 2*count_jobs)))
            do j = 1, count_jobs
                call move_alloc(jobs(j)%roots, grown(j)%roots)
                call move_alloc(jobs(j)%title, grown(j)%title)
                grown(j)%relation = jobs(j)%relation
                grown(j)%forward = jobs(j)%forward
                grown(j)%max_depth = jobs(j)%max_depth
                grown(j)%max_nodes = jobs(j)%max_nodes
                grown(j)%direction = jobs(j)%direction
                grown(j)%owner = jobs(j)%owner
                grown(j)%list_page = jobs(j)%list_page
            end do
            call move_alloc(grown, jobs)
        end if
        count_jobs = count_jobs + 1
        associate (job => jobs(count_jobs))
            job%roots = start
            job%title = title
            job%relation = relation
            job%forward = forward
            job%max_depth = max_depth
            job%max_nodes = max_nodes
            job%direction = direction
            job%owner = owner
            job%list_page = page
        end associate
    end subroutine add_job

end subroutine build_graphs