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).