1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        jan@swi.psy.uva.nl
    5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    6    Copyright (c)  2003-2011, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(tabbed_window, []).   36:- use_module(library(pce)).   37:- use_module(library(hyper)).   38
   39/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   40This class creates a tabbed window:  a   window  displaying  a number of
   41tabs, each displaying a window.   Here is some simple code using it:
   42
   43test :-
   44        new(TW, tabbed_window('Nice tabs')),
   45        send(TW, append, new(P, picture)),
   46        send(P, display, box(200, 200), point(50,50)),
   47        send(TW, append, new(view)),
   48        send(TW, append, new(D, dialog)),
   49        send(D, append, text_item(name)),
   50        send(D, append, button(quit, message(TW, destroy))),
   51        send(TW, open).
   52- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   53
   54
   55:- pce_begin_class(tabbed_window, dialog,
   56                   "Resizeable window holding set of tabs").
   57
   58variable(label_popup,   popup*, both, "Popup shown on labels").
   59
   60initialise(W, Label:label=[name], Size:size=[size],
   61           Display:display=[display]) :->
   62    send_super(W, initialise, Label, Size, Display),
   63    send(W, hor_stretch, 100),
   64    send(W, ver_stretch, 100),
   65    send(W, hor_shrink, 100),
   66    send(W, ver_shrink, 100),
   67    send(W, pen, 0),
   68    send(W, border, size(0,0)),
   69    send_super(W, append, new(tab_stack)).
   70
   71resize(W, Tab:[tab]) :->
   72    "Resize member tabs to fit the dialog"::
   73    get_super(W, member, tab_stack, TS),
   74    get(W, area, area(_,_,Width, Height)),
   75    new(LabelH, number(0)),
   76    send(TS?graphicals, for_all,
   77         message(LabelH, maximum, @arg1?label_size?height)),
   78    get(LabelH, value, LH),
   79    TabH is Height - LH,
   80    (   Tab == @default
   81    ->  send(TS?graphicals, for_all,
   82             message(@arg1, size, size(Width,TabH)))
   83    ;   send(Tab, size, size(Width,TabH))
   84    ).
   85
   86layout_dialog(W, _Gap:[size], _Size:[size], _Border:[size]) :->
   87    "Overrule to deal with nested tabbed windows"::
   88    new(S0, size(0,0)),
   89    send_super(W, layout_dialog, S0, S0, S0).
   90
   91:- pce_group(stack).
   92
   93on_top(W, Top:'name|window') :->
   94    "Put the named tab or tab containing Window on top"::
   95    get_super(W, member, tab_stack, TS),
   96    (   atom(Top)
   97    ->  (   get(TS, member, Top, Tab)
   98        ->  send(TS, on_top, Tab)
   99        ;   get(W, hypered, tab, @arg3?name == Top, Window)
  100        ->  send(Window, expose)
  101        )
  102    ;   get(Top, container, window_tab, Tab)
  103    ->  send(TS, on_top, Tab)
  104    ).
  105
  106
  107current(W, Window:window) :<-
  108    "Window of currently selected tab"::
  109    get_super(W, member, tab_stack, TS),
  110    get(TS, on_top, Tab),
  111    get(Tab, window, Window).
  112
  113current(W, Window:window) :->
  114    "Window of currently selected tab"::
  115    get(Window, container, window_tab, Tab),
  116    (   get(Tab, status, on_top)
  117    ->  send(W, resize, Tab)
  118    ;   get_super(W, member, tab_stack, TS),
  119        send(TS, on_top, Tab)
  120    ).
  121
  122:- pce_group(members).
  123
  124%       ->append: Window, Label, [Expose]
  125%
  126%       Append a new tab using Window with the given tab label.
  127%
  128%       The call to ->'_compute_desired_size' should be properly delayed
  129%       until the tabbed window is actually   created,  but this doesn't
  130%       appear to work properly. If Expose == @on the tab is immediately
  131%       brought to the top.
  132
  133append(W, Window:window=window, Label:name=[name], Expose:expose=[bool]) :->
  134    "Append a window to the tabs"::
  135    send(Window, '_compute_desired_size'),
  136    send(W, tab, new(Tab, window_tab(Window, Label))),
  137    (   Expose == @on
  138    ->  send(W, resize, Tab),
  139        get_super(W, member, tab_stack, TS),
  140        send(TS, on_top, Tab)
  141    ;   true
  142    ).
  143
  144member(W, Name:name, Window:window) :<-
  145    "Get named window from tabbed window"::
  146    get_super(W, member, tab_stack, TS),
  147    get(TS, member, Name, Tab),
  148    get(Tab, window, Window).
  149
  150members(W, Windows:chain) :<-
  151    "New chain with member windows"::
  152    new(Windows, chain),
  153    get_super(W, member, tab_stack, TS),
  154    send(TS?graphicals, for_all,
  155         message(Windows, append, @arg1?window)),
  156    (   get(W, all_hypers, Hypers)
  157    ->  send(Hypers, for_all,
  158             if(@arg1?forward_name == toplevel,
  159                message(Windows, append, @arg1?to)))
  160    ;   true
  161    ).
  162
  163clear(W) :->
  164    "Remove all member tabs"::
  165    get_super(W, member, tab_stack, TS),
  166    send(TS, clear).
  167
  168tab(W, Tab:tab) :->
  169    "Add normal tab"::
  170    get_super(W, member, tab_stack, TS),
  171    send(TS, append, Tab),
  172    (   get(W, is_displayed, @on)
  173    ->  send(W, resize, Tab)
  174    ;   true
  175    ).
  176
  177tab(W, Name:name, Tab:tab) :<-
  178    "Find named tab"::
  179    get_super(W, member, tab_stack, TS),
  180    get(TS, member, Name, Tab).
  181
  182empty(_W) :->
  183    "Abstract method.  Called if last window disappears"::
  184    true.
  185
  186:- pce_group(frame).
  187
  188frame_window(TW, Window:window, Name:name, Rank:'1..', Frame:frame) :<-
  189    "After un-tabbing, give the window a new frame"::
  190    new(Frame, window_tab_frame(Window, Name, Rank)),
  191    new(_, partof_hyper(TW, Window, toplevel, tab)).
  192
  193:- pce_end_class(tabbed_window).
  194
  195
  196                 /*******************************
  197                 *           WINDOW TAB         *
  198                 *******************************/
  199
  200
  201:- pce_begin_class(window_tab(name), tab,
  202                   "Tab displaying a window").
  203
  204variable(window,        window*,      get, "Displayed window").
  205variable(closing,       bool := @off, get, "We are about to close").
  206delegate_to(window).
  207
  208initialise(T, Window:window=[window], Name:name=[name]) :->
  209    "Create from window and name"::
  210    (   Window == @default
  211    ->  new(W, picture)
  212    ;   W = Window
  213    ),
  214    (   Name == @default
  215    ->  get(W, name, TheName)
  216    ;   TheName = Name
  217    ),
  218    (   get(W, decoration, Decor),
  219        Decor \== @nil
  220    ->  true
  221    ;   Decor = Window
  222    ),
  223    send(Decor, lock_object, @on),
  224    (   get(Decor, slot, frame, Frame),
  225        Frame \== @nil
  226    ->  send(Frame, delete, Decor)
  227    ;   true
  228    ),
  229    send(Decor, slot, tile, @nil),
  230    send_super(T, initialise, TheName),
  231    send(T, border, size(0,0)),
  232    send_super(T, display, Decor),
  233    get(Decor, unlock, _),
  234    send(T, slot, window, W),
  235    new(_, mutual_dependency_hyper(T, W, window, tab)).
  236
  237unlink(Tab) :->
  238    "Trap if I'm the last tab"::
  239    (   get(Tab, device, Dev),
  240        Dev \== @nil
  241    ->  get(Dev?graphicals, size, Count),
  242        (   Count == 1
  243        ->  get(Tab, container, tabbed_window, TabbedWindow),
  244            send_super(Tab, unlink),
  245            send(TabbedWindow, empty)
  246        ;   send_super(Tab, unlink)
  247        )
  248    ;   send_super(Tab, unlink)
  249    ).
  250
  251:- pce_group(resize).
  252
  253%       ->size
  254%
  255%       This method must update the size of  the window. For some, to me
  256%       unknown,  reason  this  does  not    work  correctly  when  done
  257%       immediately.  Possibly  this  has  something   to  do  with  X11
  258%       synchronisation. We use the hack   in_pce_thread/1 to reschedule
  259%       the window resize in the event loop.
  260
  261size(T, Size:size) :->
  262    "Adjust size of tab and window"::
  263    (   get(T, closing, @on)
  264    ->  true
  265    ;   in_pce_thread(resize_window(T)),
  266        send_super(T, size, Size)
  267    ).
  268
  269resize_window(T) :-
  270    (   object(T)                             % but the window may be gone
  271    ->  send(T, resize_window)
  272    ;   true
  273    ).
  274
  275resize_window(T) :->
  276    get(T, size, size(W, H)),
  277    get(T, window, Window),
  278    (   get(Window, decoration, Decor),
  279        Decor \== @nil
  280    ->  Resize = Decor
  281    ;   Resize = Window
  282    ),
  283    send(Resize, do_set, 0,0,W,H).
  284
  285:- pce_group(event).
  286
  287status(T, Status:{on_top,hidden}) :->
  288    send_super(T, status, Status),
  289    (   Status == on_top,
  290        get(T, is_displayed, @on),
  291        get(T, container, tabbed_window, TabbedWindow)
  292    ->  send(TabbedWindow, current, T?window)
  293    ;   true
  294    ).
  295
  296:- pce_group(delegate).
  297
  298display(T, Gr:graphical, Pos:[point]) :->
  299    "Delegate to window"::
  300    get(T, window, Window),
  301    send(Window, display, Gr, Pos).
  302
  303append(T, Item:graphical, RelPos:[{below,right,next_row}]) :->
  304    "Delegate to window"::
  305    get(T, window, Window),
  306    send(Window, append, Item, RelPos).
  307
  308:- pce_group(event).
  309
  310label_popup(Tab, Popup:popup) :<-
  311    "Get popup for label"::
  312    get_super(Tab, window, TabbedWindow),
  313    get(TabbedWindow, label_popup, Popup),
  314    Popup \== @nil.
  315
  316:- pce_global(@window_tab_label_recogniser,
  317              new(popup_gesture(@receiver?label_popup))).
  318
  319label_event(G, Ev:event) :->
  320    "Show popup on label of tab"::
  321    (   send_super(G, label_event, Ev)
  322    ->  true
  323    ;   send(@window_tab_label_recogniser, event, Ev)
  324    ).
  325
  326:- pce_group(frame).
  327
  328rank(Tab, Rank:'1..') :<-
  329    "Get position number of the tab"::
  330    get(Tab, device, Stack),
  331    get(Stack?graphicals, index, Tab, Rank).
  332
  333rank(Tab, Rank:'1..') :->
  334    "Move tab in rank"::
  335    get(Tab, device, Stack),
  336    get(Stack?graphicals, index, Tab, Rank0),
  337    (   Rank == Rank0
  338    ->  true
  339    ;   (   Rank > Rank0
  340        ->  Rank1 is Rank+1
  341        ;   Rank1 = Rank
  342        ),
  343        (   Rank1 == 1
  344        ->  send(Tab, hide)
  345        ;   Before is Rank1 - 1,
  346            get(Stack?graphicals, nth1, Before, BeforeGr)
  347        ->  send(Tab, expose, BeforeGr)
  348        ;   send(Tab, expose)               % make last one
  349        ),
  350        send(Stack, layout_labels)
  351    ).
  352
  353untab(Tab, W:window) :<-
  354    "Remove a tab from the tabbed window and return the window"::
  355    get(Tab, window, W),
  356    send(W, lock_object, @on),
  357    send(Tab, delete_hypers, window),
  358    free(Tab),
  359    get(W, unlock, _).
  360
  361untab(Tab) :->
  362    "Turn the window into a toplevel window"::
  363    get(Tab, rank, Rank),
  364    get(Tab, name, Name),
  365    get(Tab, container, dialog, TabbedWindow),
  366    get(Tab, display_position, point(X, Y)),
  367    get(Tab, untab, Window),
  368    get(TabbedWindow, frame_window, Window, Name, Rank, Frame),
  369    send(Frame, open, point(X, Y+20)).
  370
  371%       ->close_other_tabs
  372%
  373%       Close all tabs but me. To work   around scheduled resize for the
  374%       subwindows we first indicate we are about to close the tabs. See
  375%       also ->size.
  376
  377close_other_tabs(Tab) :->
  378    "Destroy all tabs except for me"::
  379    get(Tab, device, Stack),
  380    send(Stack?graphicals, for_all,
  381         if(@arg1 \== Tab,
  382            message(@arg1, slot, closing, @on))),
  383    send(Stack?graphicals, for_all,
  384         if(@arg1 \== Tab,
  385            message(@arg1, destroy))).
  386
  387:- pce_end_class(window_tab).
  388
  389
  390:- pce_begin_class(window_tab_frame, frame,
  391                   "Temporary frame for an untabbed window").
  392
  393variable(rank, '1..', get, "Saved position in tabbed window").
  394
  395initialise(F, Window:window, Name:name, Rank:'1..') :->
  396    send(F, slot, rank, Rank),
  397    send_super(F, initialise, Name?label_name),
  398    send(F, append, Window),
  399    send(F, done_message, message(F, retab)).
  400
  401
  402window(F, Window:window) :<-
  403    "Get the un-tabbed window"::
  404    get(F?members, head, Window).
  405
  406retab(F) :->
  407    "Bring the window back to its tab"::
  408    get(F, window, Window),
  409    get(Window, hypered, tab, TabbedWindow),
  410    get(F, rank, Rank),
  411    send(F, delete, Window),
  412    send(Window, delete_hypers, tab),
  413    send(TabbedWindow, append, Window),
  414    get(Window, container, tab, Tab),
  415    send(Tab, rank, Rank),
  416    send(F, destroy).
  417
  418contained_in(F, TabbedWindow:tabbed_window) :<-
  419    "An untabbed window is consider part of the tab"::
  420    get(F, window, Window),
  421    get(Window, hypered, tab, TabbedWindow).
  422
  423:- pce_end_class(window_tab_frame)