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(send(T, resize_window)),
  266        send_super(T, size, Size)
  267    ).
  268
  269resize_window(T) :->
  270    get(T, size, size(W, H)),
  271    get(T, window, Window),
  272    (   get(Window, decoration, Decor),
  273        Decor \== @nil
  274    ->  Resize = Decor
  275    ;   Resize = Window
  276    ),
  277    send(Resize, do_set, 0,0,W,H).
  278
  279:- pce_group(event).
  280
  281status(T, Status:{on_top,hidden}) :->
  282    send_super(T, status, Status),
  283    (   Status == on_top,
  284        get(T, is_displayed, @on),
  285        get(T, container, tabbed_window, TabbedWindow)
  286    ->  send(TabbedWindow, current, T?window)
  287    ;   true
  288    ).
  289
  290:- pce_group(delegate).
  291
  292display(T, Gr:graphical, Pos:[point]) :->
  293    "Delegate to window"::
  294    get(T, window, Window),
  295    send(Window, display, Gr, Pos).
  296
  297append(T, Item:graphical, RelPos:[{below,right,next_row}]) :->
  298    "Delegate to window"::
  299    get(T, window, Window),
  300    send(Window, append, Item, RelPos).
  301
  302:- pce_group(event).
  303
  304label_popup(Tab, Popup:popup) :<-
  305    "Get popup for label"::
  306    get_super(Tab, window, TabbedWindow),
  307    get(TabbedWindow, label_popup, Popup),
  308    Popup \== @nil.
  309
  310:- pce_global(@window_tab_label_recogniser,
  311              new(popup_gesture(@receiver?label_popup))).
  312
  313label_event(G, Ev:event) :->
  314    "Show popup on label of tab"::
  315    (   send_super(G, label_event, Ev)
  316    ->  true
  317    ;   send(@window_tab_label_recogniser, event, Ev)
  318    ).
  319
  320:- pce_group(frame).
  321
  322rank(Tab, Rank:'1..') :<-
  323    "Get position number of the tab"::
  324    get(Tab, device, Stack),
  325    get(Stack?graphicals, index, Tab, Rank).
  326
  327rank(Tab, Rank:'1..') :->
  328    "Move tab in rank"::
  329    get(Tab, device, Stack),
  330    get(Stack?graphicals, index, Tab, Rank0),
  331    (   Rank == Rank0
  332    ->  true
  333    ;   (   Rank > Rank0
  334        ->  Rank1 is Rank+1
  335        ;   Rank1 = Rank
  336        ),
  337        (   Rank1 == 1
  338        ->  send(Tab, hide)
  339        ;   Before is Rank1 - 1,
  340            get(Stack?graphicals, nth1, Before, BeforeGr)
  341        ->  send(Tab, expose, BeforeGr)
  342        ;   send(Tab, expose)               % make last one
  343        ),
  344        send(Stack, layout_labels)
  345    ).
  346
  347untab(Tab, W:window) :<-
  348    "Remove a tab from the tabbed window and return the window"::
  349    get(Tab, window, W),
  350    send(W, lock_object, @on),
  351    send(Tab, delete_hypers, window),
  352    free(Tab),
  353    get(W, unlock, _).
  354
  355untab(Tab) :->
  356    "Turn the window into a toplevel window"::
  357    get(Tab, rank, Rank),
  358    get(Tab, name, Name),
  359    get(Tab, container, dialog, TabbedWindow),
  360    get(Tab, display_position, point(X, Y)),
  361    get(Tab, untab, Window),
  362    get(TabbedWindow, frame_window, Window, Name, Rank, Frame),
  363    send(Frame, open, point(X, Y+20)).
  364
  365%       ->close_other_tabs
  366%
  367%       Close all tabs but me. To work   around scheduled resize for the
  368%       subwindows we first indicate we are about to close the tabs. See
  369%       also ->size.
  370
  371close_other_tabs(Tab) :->
  372    "Destroy all tabs except for me"::
  373    get(Tab, device, Stack),
  374    send(Stack?graphicals, for_all,
  375         if(@arg1 \== Tab,
  376            message(@arg1, slot, closing, @on))),
  377    send(Stack?graphicals, for_all,
  378         if(@arg1 \== Tab,
  379            message(@arg1, destroy))).
  380
  381:- pce_end_class(window_tab).
  382
  383
  384:- pce_begin_class(window_tab_frame, frame,
  385                   "Temporary frame for an untabbed window").
  386
  387variable(rank, '1..', get, "Saved position in tabbed window").
  388
  389initialise(F, Window:window, Name:name, Rank:'1..') :->
  390    send(F, slot, rank, Rank),
  391    send_super(F, initialise, Name?label_name),
  392    send(F, append, Window),
  393    send(F, done_message, message(F, retab)).
  394
  395
  396window(F, Window:window) :<-
  397    "Get the un-tabbed window"::
  398    get(F?members, head, Window).
  399
  400retab(F) :->
  401    "Bring the window back to its tab"::
  402    get(F, window, Window),
  403    get(Window, hypered, tab, TabbedWindow),
  404    get(F, rank, Rank),
  405    send(F, delete, Window),
  406    send(Window, delete_hypers, tab),
  407    send(TabbedWindow, append, Window),
  408    get(Window, container, tab, Tab),
  409    send(Tab, rank, Rank),
  410    send(F, destroy).
  411
  412contained_in(F, TabbedWindow:tabbed_window) :<-
  413    "An untabbed window is consider part of the tab"::
  414    get(F, window, Window),
  415    get(Window, hypered, tab, TabbedWindow).
  416
  417:- pce_end_class(window_tab_frame)