/*  Part of XPCE --- The SWI-Prolog GUI toolkit

    Author:        Jan Wielemaker and Anjo Anjewierden
    E-mail:        J.Wielemaker@vu.nl
    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    Copyright (c)  2001-2020, University of Amsterdam
                              VU University Amsterdam
                              CWI, Amsterdam
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

:- module(prolog_navigator, []).
:- use_module(library(pce)).
:- use_module(library(persistent_frame)).
:- use_module(library(toc_filesystem)).
:- use_module(library(pce_report)).
:- use_module(library(toolbar)).
% used in load hook: cannot be autoloaded.
:- use_module(library(trace/util),[canonical_source_file/2]).

:- autoload(browse_xref,
	    [ x_browse_info/2,
	      x_browse_analyse/1,
	      system_predicate/1,
	      global_predicate/1
	    ]).
:- use_module(library(debug),[debug/3]).
:- autoload(library(prolog_code), [head_name_arity/3]).
:- autoload(library(prolog_debug), [nospy/1, spy/1]).
:- autoload(library(edit),[edit/1]).
:- autoload(library(help),[help/1]).
:- autoload(library(lists),[member/2]).
:- autoload(library(pce_debug),
	    [nospypce/1,spypce/1,notracepce/1,tracepce/1]).
:- autoload(library(pce_image),[pce_image_directory/1]).
:- autoload(library(pce_manual),[manpce/1,manpce/0]).
:- autoload(library(pce_util),[send_list/3,default/3,get_chain/3]).
:- autoload(library(prolog_source),
	    [ prolog_open_source/2,
	      prolog_read_source_term/4,
	      prolog_close_source/1
	    ]).
:- autoload(library(prolog_trace),[trace/2,trace/1]).
:- autoload(library(swi_ide),[prolog_ide/1]).
:- if(exists_source(library(pldoc/man_index))).
:- autoload(library(pldoc/man_index),[man_object_property/2]).
:- endif.

:- pce_image_directory(library('trace/icons')).

:- dynamic
    prolog_overview_window/1.

resource(edit,        image, image('16x16/edit.xpm')).
resource(up,          image, image('16x16/up.xpm')).
resource(refresh,     image, image('16x16/refresh.xpm')).
resource(butterfly,   image, image('butterfly.xpm')).
resource(dbgsettings, image, image('16x16/dbgsettings.xpm')).

:- pce_begin_class(prolog_navigator, persistent_frame,
                   "Prolog source navigator").

initialise(SB, Root:directory) :->
    send_super(SB, initialise, 'Prolog Navigator'),
    send(SB, icon, resource(butterfly)),
    send(SB, append, new(D, dialog)),
    send(new(W, prolog_source_structure(Root)), below, D),
    send(D, append, new(tool_bar(W))),
    send(D, gap, size(0, 2)),
    send(D, pen, 0),
    send(SB, fill_tool_bar),
    send(new(report_dialog), below, W).

tool_bar(SB, TB:tool_bar) :<-
    "Get the toolbar"::
    get(SB, member, dialog, D),
    get(D, member, tool_bar, TB).

fill_tool_bar(SB) :->
    "Fill the toolbar"::
    get(SB, tool_bar, TB),
    send_list(TB, append,
              [ tool_button(up,
                            resource(up),
                            'Up one level'),
                tool_button(refresh,
                            resource(refresh),
                            'Update view'),
                gap,
                tool_button(debug_settings,
                            resource(dbgsettings),
                            'Edit breakpoints'),
                tool_button(edit,
                            resource(edit),
                            'Open file in editor')
              ]).

goto(SB, File:file, Line:int) :->
    "Expand and highlight tree for given location"::
    get(SB, member, prolog_source_structure, FB),
    send(FB, goto, File, Line).

directory(SB, Dir:directory) :->
    "Make directory visible"::
    get(SB, member, prolog_source_structure, FB),
    get(FB, dir_node, Dir, @on, _Node).

:- pce_end_class(prolog_navigator).


:- pce_begin_class(prolog_source_structure, toc_filesystem,
                   "Browser for (prolog) source-files").

class_variable(auto_refresh, int*, @nil).
class_variable(size,    size,   size(200, 500),
               "Intial window size").

variable(file_pattern,  regex, get, "Pattern of showed files").

initialise(FB, Root:directory) :->
    source_pattern(Regex),
    send(FB, slot, file_pattern, Regex),
    send_super(FB, initialise, Root),
    send(FB?frame, label, 'SWI-Prolog Navigator'),
    asserta(prolog_overview_window(FB)).

source_pattern(Pat) :-
    findall(E, (user:prolog_file_type(E, prolog),
                \+ user:prolog_file_type(E, qlf)), Exts),
    (   Exts = [Ext]
    ->  format(atom(Pat), '.*\\.~w$', [Ext])
    ;   atomic_list_concat(Exts, '|', P1),
        format(atom(Pat), '.*\\.(~w)$', [P1])
    ).

unlink(FB) :->
    retractall(prolog_overview_window(FB)),
    send_super(FB, unlink).

make_file_node(_FB, File:file, Node:sb_prolog_file) :<-
    "Return a Prolog source-file node"::
    new(Node, sb_prolog_file(File)).

:- pce_group(navigate).

file_node(FB, File:name, Create:[bool], Node:toc_node) :<-
    "Get node for file, possibly add it to the tree"::
    canonical_source_file(File, Path),
    (   get(FB, node, Path, Node)
    ->  true
    ;   Create == @on
    ->  file_directory_name(Path, Dir),
        get(FB, dir_node, Dir, @on, DirNode),
        send(DirNode, collapsed, @off),
        get(FB, node, Path, Node)
    ).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
->goto: File, Line opens  the  tree   such  that  the indicated position
becomes visible and selects the entity   holding the specified location.
First it looks for the file, then it  assumes the sons are in file-order
and looks for the first son after the requested line. After finding this
it iterates on this.

This method is intended to synchronise with an editor.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

goto(FB, File:'file|node', Line:int) :->
    "Show indicated position"::
    (   send(File, instance_of, file)
    ->  get(FB, file_node, File?name, @on, Node)
    ;   Node = File
    ),
    (   (   get(Node, collapsed, @nil)
        ;   send(Node, instance_of, sb_predicate)
        )
    ->  send(FB?tree, selection, Node),
        send(FB, normalise, Node)
    ;   send(Node, collapsed, @off),
        new(N, var(value := @nil)),
        (   get(Node?sons, find,
                and(message(@arg1, has_get_method, line),
                    if(and(@arg1?line \== @nil,
                           @arg1?line > Line),
                       new(and),
                       and(assign(N, @arg1, global),
                           new(or)))),
                _)
        ->  get(N, '_value', N2),
            (   N2 == @nil
            ->  send(FB?tree, selection, Node),
                send(FB, normalise, Node)
            ;   send(FB, goto, N2, Line)
            )
        ;   get(Node?sons, tail, Last)
        ->  send(FB, goto, Last, Line)
        ;   send(FB?tree, selection, Node),
            send(FB, normalise, Node)
        )
    ).

:- pce_group(popup).

popup(FB, Id:any, Popup:popup) :<-
    "Return popup from current node"::
    get(FB, node, Id, Node),
    (   send(Node, has_get_method, popup),
        get(Node, popup, Popup)
    ->  true
    ;   send(Node, instance_of, toc_directory)
    ->  new(Popup, popup(options)),
        send(Popup, append,
             menu_item(expand_all,
                       message(Node, expand_all)))
    ).


:- pce_group(edit).

edit(FB) :->
    "Edit selected file"::
    (   get(FB, selection, Sel),
        get(Sel, head, FileNode),
        send(FileNode, instance_of, sb_prolog_file),
        get(FileNode, identifier, File),
        edit(file(File))
    ;   send(FB, report, warning, 'No selected file'),
        fail
    ).

debug_settings(_FB) :->
    "Open debug-status editor"::
    prolog_ide(open_debug_status).

:- pce_group(event).

event(FB, Ev:event) :->
    "Deal with identifying nodes"::
    (   send_super(FB, event, Ev)
    ->  true
    ;   send(Ev, is_a, loc_move)
    ->  (   get(FB, hypered, current, Node)
        ->  (   send(Ev, inside, Node)
            ->  true
            ;   send(FB, delete_hypers, current),
                send(FB, report, status, '')
            )
        ;   get(FB, find, Ev, @arg1?node, Img),
            new(_, hyper(FB, Img, current, toc)),
            get(Img, node, Node),
            (   send(Node, has_send_method, identify)
            ->  send(Node, identify)
            ;   true
            )
        )
    ).

:- pce_end_class(prolog_source_structure).


:- pce_begin_class(sb_prolog_file, toc_folder,
                   "Display a Prolog file").

initialise(TF, File:file) :->
    get(File, name, FileName),
    canonical_source_file(FileName, Path),
    file_image(Path, Img),
    file_base_name(FileName, Base),
    send_super(TF, initialise, Base, Path, Img),
    send(TF, name, Base).

update_image(_TF) :->
    true.

loaded(TF) :->
    get(TF, identifier, Path),
    source_file(Path).

included(TF) :->
    get(TF, identifier, Path),
    included_file(Path).

file_image(Path, 'plloadedfile.xpm') :-
    source_file(Path),
    !.
file_image(Path, 'plincludedfile.xpm') :-
    included_file(Path),
    !.
file_image(_, 'plfile.xpm').

included_file(Path) :-
    source_file_property(Path, included_in(_,_)).


module(TF, Module:name) :<-
    "Return module defined in this file"::
    get(TF, identifier, Path),
    (   x_browse_info(Path, entity(module(Module), _Line))
    ->  true
    ;   catch(module_of_path(Path, Module), _, fail)
    ).

module_of_path(Path, Module) :-
    catch(setup_call_cleanup(
              prolog_open_source(Path, Stream),
              prolog_read_source_term(Stream, Term, _, []),
              prolog_close_source(Stream)), _,
          fail),
    Term = (:- module(Module, _Public)).

hidden_entity(module(_)).

file_expansion_entity(Path, entity(module(Module), Line)) :-
    once(x_browse_info(Path, entity(module(Module), Line))).
file_expansion_entity(Path, entity(dynamic, -)) :-
    once(file_expansion_entity(Path, entity(dynamic(_), _))).
file_expansion_entity(Path, Entity) :-
    x_browse_info(Path, Entity),
    arg(1, Entity, Term),
    \+ hidden_entity(Term).

expand(TF) :->
    get(TF, identifier, Path),
    get(TF, window, TocWindow),
    x_browse_analyse(Path),
    (   file_expansion_entity(Path, entity(Info, Line)),
        make_file_toc_entry(Info, Path, Entry),
        send(TocWindow, son, TF, Entry),
        send(Entry, file_id, Path),
        integer(Line),
        send(Entry, line, Line),
        fail
    ;   true
    ).

expand_all(_TF) :->
    true.

split_head(M:Head, Name, Arity, M) :-
    !,
    callable(Head),
    head_name_arity(Head, Name, Arity).
split_head(Head, Name, Arity, @nil) :-
    callable(Head),
    head_name_arity(Head, Name, Arity).

make_file_toc_entry(predicate(Head), Key, TE) :-
    split_head(Head, Name, Arity, Module),
    new(TE, sb_predicate(Key, Name, Arity, Module)).
make_file_toc_entry(grammar_rule(Head), Key, TE) :-
    split_head(Head, Name, Arity, Module),
    new(TE, sb_predicate(Key, Name, Arity, Module)).
make_file_toc_entry(Term, _Key, TE) :-
    make_file_toc_entry(Term, TE).

make_file_toc_entry(xpce_class(Class, _Super, Doc), TE) :-
    to_summary(Doc, PceDoc),
    new(TE, toc_xpce_class(Class, PceDoc)).
make_file_toc_entry(xpce_class_extension(Class), TE) :-
    new(TE, toc_xpce_class(Class, @default, 'classext.xpm')).
make_file_toc_entry(module(Module), TE) :-
    new(TE, toc_module(Module, @default, 'module.xpm')).
make_file_toc_entry(dynamic, TE) :-
    new(TE, sb_predicate_list(dynamic, @default, 'mini-run.xpm')).

to_summary(Doc, String) :-
    catch(string_codes(String, Doc), _, fail),
    !.
to_summary(_, @default).

local_predicate_name(M:Head, Label) :-
    !,
    callable(Head),
    head_name_arity(Head, Name, Arity),
    atomic_list_concat([M, :, Name, /, Arity], Label).
local_predicate_name(Head, Label) :-
    head_name_arity(Head, Name, Arity),
    atomic_list_concat([Name, /, Arity], Label).

identify(TF) :->
    "Identify myself"::
    get(TF, identifier, Path),
    (   send(TF, loaded)
    ->  send(TF, report, status, 'Loaded file %s', Path)
    ;   send(TF, included)
    ->  send(TF, report, status, 'Included file %s', Path)
    ;   send(TF, report, status, 'File %s', Path)
    ).

:- pce_group(popup).

:- free(@sb_file_popup).
:- pce_global(@sb_file_popup, make_sb_file_popup).

make_sb_file_popup(P) :-
    new(P, popup(source_options)),

    send_list(P, append,
              [ menu_item(edit,
                          message(@arg1, edit)),
                menu_item(consult,
                          message(@arg1, consult))
              ]).

popup(_, Popup:popup) :<-
    Popup = @sb_file_popup.

edit(TF) :->
    get(TF, identifier, Path),
    edit(file(Path)).

consult(TF) :->
    "Load into Prolog"::
    get(TF, identifier, Path),
    ensure_loaded(user:Path).

:- pce_end_class(sb_prolog_file).

:- pce_begin_class(toc_source_folder, toc_folder,
                   "Representation of a source entity").

variable(file_id,       name,   both, "File it was loaded from").
variable(line,          int*,   both, "Line it is associated with").

update_image(_) :->
    true.

open(TE) :->
    "Synonym for ->edit"::
    send(TE, edit).

edit(TE) :->
    "Open definition in editor"::
    get(TE, file_id, File),
    get(TE, line, Line),
    (   integer(Line)
    ->  edit(file(File, line(Line)))
    ;   send(TE, report, error, 'No source')
    ).

has_source(TE) :->
    "Has associated source"::
    get(TE, line, Line),
    integer(Line).

status(TE, Status:{open,close}) :<-
    get(TE, collapsed, Val),
    (   Val == @on
    ->  Status = close
    ;   Status = open
    ).

:- pce_group(popup).

:- free(@source_popup).
:- pce_global(@source_popup, make_source_popup).

make_source_popup(P) :-
    new(P, popup(source_options)),

    send_list(P, append,
              [ menu_item(edit,
                          message(@arg1, edit),
                          condition := message(@arg1, has_source))
              ]).

popup(_, Popup:popup) :<-
    Popup = @source_popup.

:- pce_end_class.

:- pce_begin_class(toc_xpce_entity, toc_file,
                   "Representation of an XPCE source entity").

variable(file_id,       name,   both, "File it was loaded from").
variable(line,          int*,   both, "Line it is associated with").


open(TE) :->
    send(TE, edit).

edit(TE) :->
    "Edit the source"::
    get(TE, file_id, File),
    get(TE, line, Line),
    (   integer(Line)
    ->  edit(file(File, line(Line)))
    ;   send(TE, report, error, 'No source')
    ).

has_source(TE) :->
    "Has associated source"::
    get(TE, line, Line),
    integer(Line).

loaded(TE) :->
    "Test if class is loaded"::
    get(TE, identifier, Id),
    atomic_list_concat([_Type, _Name, Class], $, Id),
    pce_prolog_class(Class).

behaviour(TE, Behaviour:behaviour) :<-
    "Get behaviour (if loaded)"::
    get(TE, identifier, Id),
    atomic_list_concat([Type, Name, Class], $, Id),
    get(@pce, convert, Class, class, ClassObj),
    (   Type == send
    ->  get(ClassObj, send_method, Name, Behaviour)
    ;   Type == get
    ->  get(ClassObj, get_method, Name, Behaviour)
    ;   Type == var
    ->  get(ClassObj, instance_variable, Name, Behaviour)
    ;   Type == cvar
    ->  get(ClassObj, class_variable, Name, Behaviour)
    ).

spy(TE, Val:[bool]) :->
    "Set spy-point"::
    get(TE, behaviour, Behaviour),
    (   Val == @off
    ->  nospypce(Behaviour)
    ;   spypce(Behaviour)
    ).

trace(TE, Val:[bool]) :->
    "Set trace-point"::
    get(TE, behaviour, Behaviour),
    (   Val == @off
    ->  notracepce(Behaviour)
    ;   tracepce(Behaviour)
    ).

identify(TE) :->
    "Identify myself"::
    get(TE, identifier, Id),
    atomic_list_concat([Type, Name, Class], $, Id),
    identify_behaviour(Type, Name, Class, TE).

identify_behaviour(send, Name, Class, TE) :-
    send(TE, report, status, 'XPCE send method %s->%s', Class, Name).
identify_behaviour(get, Name, Class, TE) :-
    send(TE, report, status, 'XPCE get method %s<-%s', Class, Name).
identify_behaviour(var, Name, Class, TE) :-
    send(TE, report, status, 'XPCE instance variable %s-%s', Class, Name).
identify_behaviour(cvar, Name, Class, TE) :-
    send(TE, report, status, 'XPCE class variable %s.%s', Class, Name).

:- pce_group(popup).

:- free(@sb_xpce_behaviour_popup).
:- pce_global(@sb_xpce_behaviour_popup,
              make_sb_xpce_behaviour_popup).

make_sb_xpce_behaviour_popup(P) :-
    new(P, popup(predicate_options)),

    send_list(P, append,
              [ menu_item(edit,
                          message(@arg1, open),
                          condition := message(@arg1, has_source)),
                menu_item(spy,
                          message(@arg1, spy),
                          condition := message(@arg1, loaded)),
                menu_item(trace,
                          message(@arg1, trace),
                          condition := message(@arg1, loaded))
              ]).

popup(_, Popup:popup) :<-
    Popup = @sb_xpce_behaviour_popup.

:- pce_end_class(toc_xpce_entity).

:- pce_begin_class(toc_xpce_class, toc_source_folder,
                   "Representation of a class (or extension)").

variable(class_id,      name,    get, "Class it represents").
variable(summary,       string*, get, "Summary documentation").

initialise(CF, Class:name, Summary:[string], Image:[image]) :->
    "Create from ClassName, Summary and Image"::
    default(Summary, @nil, Sum),
    default(Image, 'class.xpm', Img),
    send_super(CF, initialise, Class, @default, Img),
    send(CF, slot, class_id, Class),
    send(CF, slot, summary, Sum).


expand(CF) :->
    get(CF, identifier, NodeId),
    get(CF, file_id, BrowseId),
    get(CF, class_id, Class),
    get(CF, window, TocWindow),
    (   file_expansion_entity(BrowseId, entity(Info, Line)),
        make_class_toc_enter(Info, Class, BrowseId, Entry),
        send(TocWindow, son, NodeId, Entry),
        send(Entry, file_id, BrowseId),
        integer(Line),
        send(Entry, line, Line),
        fail
    ;   true
    ).

make_class_toc_enter(xpce_class_local_predicate(Class,Head), Class, Key, TE) :-
    make_file_toc_entry(predicate(Head), Key, TE),
    !.
make_class_toc_enter(Term, Class, _Key, TE) :-
    make_class_toc_enter(Term, Class, TE).

make_class_toc_enter(xpce_method(send(Class, Name, _Doc)), Class, TE) :-
    atomic_list_concat([send, Name, Class], $, Id),
    new(TE, toc_xpce_entity(Name, Id, 'send.xpm')).
make_class_toc_enter(xpce_method(get(Class, Name, _Doc)), Class, TE) :-
    atomic_list_concat([get, Name, Class], $, Id),
    new(TE, toc_xpce_entity(Name, Id, 'get.xpm')).
make_class_toc_enter(xpce_variable(Class, Name, _Doc), Class, TE) :-
    atomic_list_concat([var, Name, Class], $, Id),
    new(TE, toc_xpce_entity(Name, Id, 'ivar.xpm')).
make_class_toc_enter(xpce_class_variable(Class, Name, _Doc), Class, TE) :-
    atomic_list_concat([cvar, Name, Class], $, Id),
    new(TE, toc_xpce_entity(Name, Id, 'classvar.xpm')).

identify(CF) :->
    "Report who I am"::
    get(CF, class_id, Class),
    (   get(CF, summary, Summary),
        Summary \== @nil
    ->  send(CF, report, status, 'XPCE class %s (%s)', Class, Summary)
    ;   send(CF, report, status, 'XPCE class %s', Class)
    ).

:- pce_group(popup).

:- free(@sb_xpce_class_popup).
:- pce_global(@sb_xpce_class_popup, make_sb_xpce_class_popup).

make_sb_xpce_class_popup(P) :-
    new(P, popup(source_options)),

    send_list(P, append,
              [ menu_item(edit,
                          message(@arg1, edit),
                          condition := message(@arg1, has_source),
                          end_group := @on),
                menu_item(class_details,
                          message(@arg1, class_details),
                          condition := message(@arg1, loaded)),
                menu_item(class_hierarchy,
                          message(@arg1, class_hierarchy),
                          condition := message(@arg1, loaded))
              ]).

popup(_, Popup:popup) :<-
    Popup = @sb_xpce_class_popup.

loaded(CF) :->
    "Test if class is loaded"::
    get(CF, class_id, Class),
    pce_prolog_class(Class).

class_details(CF) :->
    "Open ClassBrowser"::
    get(CF, class_id, Class),
    manpce(Class).

class_hierarchy(CF) :->
    "Open and direct ClassHierarchy"::
    get(CF, class_id, Class),
    manpce,
    get(@manual, start_tool, class_hierarchy, Tool),
    send(Tool, focus, Class).

:- pce_end_class(toc_xpce_class).

:- pce_begin_class(toc_module, toc_source_folder,
                   "Representation of the module").

expand(MF) :->
    get(MF, identifier, NodeId),
    get(MF, file_id, BrowseId),
    get(MF, window, TocWindow),
    (   x_browse_info(BrowseId, export(Head)),
        (   x_browse_info(BrowseId, entity(predicate(Head), Line))
        ->  make_file_toc_entry(predicate(Head), BrowseId, Entry),
            send(Entry, file_id, BrowseId),
            send(Entry, line, Line)
        ;   local_predicate_name(Head, Label),
            atom_concat('$export$', Label, Id),
            new(Entry, toc_file(Label, Id, 'pred.xpm'))
        ),
        send(TocWindow, son, NodeId, Entry),
        fail
    ;   true
    ).

update_image(MF) :->
    get(MF, status, Status),
    image(module, Status, Image),
    send(MF, image, Image).

:- pce_end_class.

:- pce_begin_class(sb_predicate_list, toc_source_folder,
                   "Representation of predicate set").

variable(set,   name,   get, "Name of the represented set").

initialise(PL, Name:name, Id:any, Img:[image]) :->
    send(PL, send_super, initialise, Name, Id, Img),
    send(PL, slot, set, Name).

expand(MF) :->
    get(MF, identifier, NodeId),
    get(MF, set, Set),
    get(MF, file_id, BrowseId),
    get(MF, window, TocWindow),
    Term =.. [Set, Head],
    (   file_expansion_entity(BrowseId, entity(Term, Line)),
        make_file_toc_entry(predicate(Head), BrowseId, Entry),
        send(Entry, file_id, BrowseId),
        send(Entry, line, Line),
        send(TocWindow, son, NodeId, Entry),
        fail
    ;   true
    ).

update_image(MF) :->
    get(MF, set, Set),
    get(MF, status, Status),
    image(Set, Status, Image),
    send(MF, image, Image).

:- pce_end_class.

:- pce_begin_class(sb_predicate, toc_source_folder,
                   "Represents a predicate").

variable(name,           name,  get, "Name of the represented predicate").
variable(arity,          int,   get, "Arity of it").
variable(module,         name*, get, "Module (or local)").
variable(classification, name,  get, "Class of the predicate").

initialise(P, BrowseId:name, Name:name, Arity:int, Module:[name]*) :->
    default(Module, @nil, M),
    head_name_arity(Head0, Name, Arity),
    (   M == @nil
    ->  Head = Head0
    ;   Head = M:Head0
    ),
    local_predicate_name(Head, Label),
    classify_predicate(Head, BrowseId, Classification),
    send(P, slot, classification, Classification),
    image(predicate, Classification, Img),
    send(P, send_super, initialise, Label, @default, Img),
    send(P, slot, name, Name),
    send(P, slot, arity, Arity),
    send(P, slot, module, M),
    (   expandable(Head, Classification)
    ->  true
    ;   send(P, collapsed, @nil)
    ).

file_node(P, Node:sb_prolog_file) :<-
    "Find associated file-node"::
    file_node(P, Node).

file_node(Node, Node) :-
    send(Node, instance_of, sb_prolog_file),
    !.
file_node(Node, FileNode) :-
    get_chain(Node, parents, Parents),
    member(Parent, Parents),
    file_node(Parent, FileNode),
    !.

head(P, Qualify:[bool], Head:prolog) :<-
    "Get the head"::
    get(P, module, M),
    get(P, name, Name),
    get(P, arity, Arity),
    head_name_arity(Head0, Name, Arity),
    (   M == @nil
    ->  (   Qualify == @on
        ->  (   get(P, file_node, SbPrologFile),
                get(SbPrologFile, module, Module)
            ->  Head = Module:Head0
            ;   Head = user:Head0
            )
        ;   Head = Head0
        )
    ;   Head = M:Head0
    ).

expandable(Head, _) :-
    prolog_xbrowse:called(_, Head).

classify_predicate(Head, Key, dcg) :-
    x_browse_info(Key, entity(grammar_rule(Head), _)),
    !.
classify_predicate(Head, Key, dynamic) :-
    x_browse_info(Key, entity(dynamic(Head), _)),
    !.
classify_predicate(Head, _, imported) :-
    prolog_xbrowse:imported(Head),
    !.
classify_predicate(Head, Key, exported) :-
    x_browse_info(Key, export(Head)).
classify_predicate(Head, _, built_in) :-
    system_predicate(Head),
    !.
classify_predicate(Head, _, global) :-
    global_predicate(Head),
    !.
classify_predicate(Head, Key, incomplete) :-
    x_browse_info(Key, entity(unreferenced_call(Head, _), _)),
    !.
classify_predicate(Head, Key, unreferenced) :-
    x_browse_info(Key, entity(unreferenced_predicate(Head), _)),
    !.
classify_predicate(Head, Key, undefined) :-
    x_browse_info(Key, entity(unreferenced_call(_, To), _)),
    memberchk(Head, To),
    !.
classify_predicate(Head, _Key, fact) :-
    \+ prolog_xbrowse:called(_, Head),
    !.
classify_predicate(_, _, local).

expand(P) :->
    get(P, file_id, Key),
    get(P, head, Head),
    get(P, window, TocWindow),
    (   prolog_xbrowse:called(Called, Head),
        make_file_toc_entry(predicate(Called), Key, TE),
        send(TocWindow, son, P, TE),
        send(TE, slot, file_id, Key),
        predicate_location(Key, Called, Line),
        send(TE, slot, line, Line),
        fail
    ;   true
    ).

predicate_location(K, Called, Line) :-
    x_browse_info(K, entity(predicate(Called), Line)),
    !.
predicate_location(K, Called, Line) :-
    x_browse_info(K, entity(dynamic(Called), Line)),
    !.
predicate_location(K, Called, Line) :-
    x_browse_info(K, entity(grammar_rule(Called), Line)),
    !.
predicate_location(K, Called, Line) :-
    x_browse_info(K, entity(xpce_class_local_predicate(_, Called), Line)),
    !.

identify(P) :->
    "Identify myself as status"::
    get(P, classification, Class),
    get(P, name, Name),
    get(P, arity, Arity),
    identify_predicate(Class, Name/Arity, P).

identify_predicate(fact, Name/Arity, P) :-
    send(P, report, status,
         'Unit-clause predicate %s/%d', Name, Arity).
identify_predicate(Class, Name/Arity, P) :-
    send(P, report, status,
         '%s predicate %s/%d', Class?label_name, Name, Arity).

open(P) :->
    "Edit, manual or expand"::
    (   send(P, has_source)
    ->  send(P, edit)
    ;   send(P, has_manual)
    ->  send(P, manual)
    ;   send_super(P, open)
    ).

manual(P) :->
    get(P, name, Name),
    get(P, arity, Arity),
    (   help(Name/Arity)
    ->  true
    ;   send(P, report, warning, 'No help for %s/%d', Name, Arity)
    ).

has_manual(P) :->
    "Succeed if there is a manual-page"::
    get(P, name, Name),
    get(P, arity, Arity),
    man_predicate_summary(Name/Arity, _).

:- if(current_predicate(man_object_property/2)).
man_predicate_summary(PI, Summary) :-
    man_object_property(PI, Summary).
:- endif.
man_predicate_summary(_, _) :-
    fail.

built_in(P) :->
    "True is represented predicate is builtin"::
    get(P, head, Head),
    system_predicate(Head).

loaded(P) :->
    "Test if represented predicate is loaded"::
    get(P, file_node, Node),
    send(Node, loaded).

spy(P, Val:[bool]) :->
    "Switch spying on/off"::
    get(P, head, @on, Head),
    (   Val == @off
    ->  nospy(Head)
    ;   spy(Head)
    ).

trace(P, Val:[bool]) :->
    "Switch tracing on/off"::
    get(P, head, @on, Head),
    (   Val == @off
    ->  trace(Head, -all)
    ;   trace(Head)
    ).

:- free(@prolog_predicate_popup).
:- pce_global(@prolog_predicate_popup,
              make_prolog_predicate_popup).

make_prolog_predicate_popup(P) :-
    new(P, popup(predicate_options)),

    send_list(P, append,
              [ menu_item(edit,
                          message(@arg1, open),
                          condition := message(@arg1, has_source)),
                menu_item(spy,
                          message(@arg1, spy),
                          condition := message(@arg1, loaded)),
                menu_item(trace,
                          message(@arg1, trace),
                          condition := message(@arg1, loaded)),
                menu_item(manual,
                          message(@arg1, manual),
                          condition := message(@arg1, has_manual))
              ]).

popup(_, Popup:popup) :<-
    Popup = @prolog_predicate_popup.

:- pce_end_class(sb_predicate).


image(module,           open,           'openmodule.xpm').
image(module,           closed,         'module.xpm').

image(dynamic,          open,           'mini-run.xpm').
image(dynamic,          closed,         'mini-run.xpm').

image(predicate,        built_in,       'builtin.xpm').
image(predicate,        global,         'mini-globe.xpm').
image(predicate,        dynamic,        'mini-run.xpm').
image(predicate,        imported,       'import.xpm').
image(predicate,        exported,       'export.xpm').
image(predicate,        incomplete,     'warnpred.xpm').
image(predicate,        unreferenced,   'unrefpred.xpm').
image(predicate,        undefined,      'undefpred.xpm').
image(predicate,        fact,           'fact.xpm').
image(predicate,        local,          'pred.xpm').
image(predicate,        dcg,            'grammar.xpm').



                 /*******************************
                 *             HOOK             *
                 *******************************/

:- multifile
    user:message_hook/3.

image_of_load_state(start, _,       'loading.xpm').
image_of_load_state(true,  load,    'plloadedfile.xpm').
image_of_load_state(true,  include, 'plincludedfile.xpm').
image_of_load_state(false, _,       'loadfailed.xpm').

user:message_hook(load_file(What), _Kind, _Lines) :-
    loading(What, load).
user:message_hook(include_file(What), _Kind, _Lines) :-
    loading(What, include).

loading(What, How) :-
    load_info(What, File, Stage),
    prolog_overview_window(Win),
    (   file_name_extension(_, qlf, File)
    ->  debug(gtrace(qlf), 'Looking for ~q', [File]),
        '$qlf_sources'(File, Sources),
        debug(gtrace(qlf), 'Contains ~q', [Sources]),
        member(TheFile, Sources)
    ;   TheFile = File
    ),
    get(Win, file_node, TheFile, Node),
    image_of_load_state(Stage, How, Img),
    in_pce_thread(update_image(Node, Img)),
    fail.

update_image(Node, Img) :-
    send(Node, image, Img),
    send(Node, flush).

load_info(start(_Level, file(_, Path)),
          Path, start).
load_info(failed(Spec),
          Path, false) :-
    absolute_file_name(Spec,
                       [ file_type(prolog),
                         access(read)
                       ],
                       Path).
load_info(done(_Level, file(_, Path), _, _, _, _),
          Path, true).
load_info(done(_Level, file(_, Path)),
          Path, true).

