1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
   2
   3    Author:        Jan Wielemaker and Anjo Anjewierden
   4    E-mail:        J.Wielemaker@cs.vu.nl
   5    WWW:           http://www.swi-prolog.org/projects/xpce/
   6    Copyright (c)  2002-2013, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(persistent_frame, []).
  37:- use_module(library(pce)).
  38:- use_module(library(pce_config)).
  39
  40/** <module> Save/restore layout of XPCE windows
  41
  42This library defines the class  persistent_frame,   a  subclass of class
  43frame remembering its geometry  and  optionally   (by  default  on)  the
  44subwindow layout.
  45
  46This class cooperates with the   library(pce_config),  a generic package
  47for managing application preferences.  It collects the locations of user
  48frames in the file <profile-dir>/Geometry.cnf
  49
  50Geometry information is stored in  the   internal  configuration DB (see
  51library(pce_config))  if  a  frame  is  closed   or  on  exit  from  the
  52application. The internal database is written   to  tehe above mentioned
  53file on exit from the application.
  54
  55Somehow the system must identify the frame   to decide which geometry to
  56use. This is done using the  <->geometry_key.   If  not set, this is the
  57classname or, if the class is not subclassed   it  is the <-label of the
  58frame.
  59
  60Exploiting this library is very simple,  just make your toplevel windows
  61for  which  you  want  the  geometry  remembered  a  subclass  of  class
  62persistent_frame rather than class frame.  Note   that  this implies you
  63have to create your frame explitely:
  64
  65    ==
  66        ...
  67        new(F, persistent_frame('Pretty Application')),
  68        send(F, geometry_key, pretty_app),
  69        send(F, append, new(D, dialog)),
  70        send(new(V, view), right, D),
  71        ...
  72    ==
  73*/
  74
  75:- pce_begin_class(persistent_frame, frame, "Frame remembering location").
  76
  77variable(persistent_subwindow_layout, bool := @on, get,
  78         "Remember the layout of the subwindows?").
  79variable(geometry_key,                name*, send,
  80         "Key used to identify this frame").
  81
  82unlink(F) :->
  83    "Save layout and destroy"::
  84    send(F, save_layout),
  85    send_super(F, unlink).
  86
  87create(F) :->
  88    "Create and restore layout"::
  89    send_super(F, create),
  90    ignore(send(F, load_layout)).
  91
  92:- pce_group(config).
  93
  94geometry_key(F, Key:name) :<-
  95    "Name to store geometry"::
  96    (   get(F, slot, geometry_key, Key),
  97        Key \== @nil
  98    ->  true
  99    ;   get(F, class_name, Key),
 100        Key \== persistent_frame
 101    ->  true
 102    ;   get(F, label, Key)
 103    ).
 104
 105save_layout(F) :->
 106    "Save current layout in config DB"::
 107    get(F, geometry, Geometry),
 108    get(F, geometry_key, Key),
 109    set_config(history/geometry/Key, Geometry),
 110    (   get(F, persistent_subwindow_layout, @on),
 111        get(F, tile, RootTile),
 112        get(RootTile, members, Members),
 113        Members \== @nil,
 114        get_tile_layout(RootTile, Layout),
 115        Layout \== *
 116    ->  set_config(history/subwindow_layout/Key, Layout)
 117    ;   true
 118    ).
 119
 120load_layout(F) :->
 121    load_geometry_config,
 122    get(F, geometry_key, Key),
 123    (   get_config(history/geometry/Key, Geometry)
 124    ->  send(F, geometry, Geometry)
 125    ;   true
 126    ),
 127    (   get(F, persistent_subwindow_layout, @on),
 128        get_config(history/subwindow_layout/Key, Layout)
 129    ->  get(F, tile, RootTile),
 130        apply_tile_layout(RootTile, Layout)
 131    ;   true
 132    ).
 133
 134%!  get_tile_layout(+Tile, -Layout)
 135%
 136%   Create a Prolog term representing the subwindow (tile) layout.
 137%   Note that we only save the width/height of resizeable subwindows,
 138%   leaving the others to the application.  This ensures proper behaviour
 139%   if the application is modified.
 140
 141get_tile_layout(T, layout(Me, SubLayout)) :-
 142    get(T, members, Members),
 143    Members \== @nil,
 144    chain_list(Members, List),
 145    maplist(get_tile_layout, List, SubLayout),
 146    get_this_tile_layout(T, Me),
 147    has_specifier(layout(Me, SubLayout)),
 148    !.
 149get_tile_layout(T, Me) :-
 150    get_this_tile_layout(T, Me).
 151
 152get_this_tile_layout(T, Size) :-
 153    get(T, can_resize, @on),
 154    !,
 155    get(T, area, A),
 156    (   get(T?super, orientation, horizontal)
 157    ->  get(A, width, Size)
 158    ;   get(A, height, Size)
 159    ).
 160get_this_tile_layout(_, *).
 161
 162%!  has_specifier(+Layout)
 163%
 164%   See whether there is a specification somewhere, otherwise there
 165%   is no use storing it.
 166
 167has_specifier(layout(Size, _)) :-
 168    Size \== *,
 169    !.
 170has_specifier(layout(_, Subs)) :-
 171    !,
 172    has_specifier(Subs).
 173has_specifier(X) :-
 174    integer(X),
 175    !.
 176has_specifier(Subs) :-
 177    member(Sub, Subs),
 178    has_specifier(Sub),
 179    !.
 180
 181
 182%!  apply_tile_layout(+Tile, +Layout)
 183%
 184%   Apply a previously saved layout description, sending ->width
 185%   or ->height messages to resizeable tiles.
 186
 187apply_tile_layout(T, layout(Me, SubLayout)) :-
 188    !,
 189    apply_this_tile_layout(T, Me),
 190    (   get(T, members, Members),
 191        Members \== @nil
 192    ->  chain_list(Members, List),
 193        maplist(apply_tile_layout, List, SubLayout)
 194    ;   true
 195    ).
 196apply_tile_layout(T, Me) :-
 197    apply_this_tile_layout(T, Me).
 198
 199apply_this_tile_layout(_, *) :- !.
 200apply_this_tile_layout(T, Size) :-
 201    get(T, super, Super),
 202    Super \== @nil,
 203    !,
 204    (   get(Super, orientation, horizontal)
 205    ->  get(T?area, width, W0),
 206        (   Size > W0
 207        ->  get(T, hor_stretch, S)
 208        ;   get(T, hor_shrink, S)
 209        ),
 210        (   S > 0
 211        ->  send(T, width, Size)
 212        ;   true
 213        )
 214    ;   get(T?area, height, H0),
 215        (   Size > H0
 216        ->  get(T, ver_stretch, S)
 217        ;   get(T, ver_shrink, S)
 218        ),
 219        (   S > 0
 220        ->  send(T, height, Size)
 221        ;   true
 222        )
 223    ).
 224apply_this_tile_layout(_, _).
 225
 226:- pce_end_class(persistent_frame).
 227
 228
 229                 /*******************************
 230                 *          EXIT HOOKS          *
 231                 *******************************/
 232
 233:- initialization
 234   send(@pce, exit_message,
 235    message(@display?frames,
 236            for_some,
 237            if(message(@arg1, instance_of, persistent_frame),
 238               message(@arg1, save_layout)))).
 239
 240
 241                 /*******************************
 242                 *         CONFIG HOOKS         *
 243                 *******************************/
 244
 245config(config/file,
 246       [ default('Geometry')
 247       ]).
 248config(history/geometry/_Key,
 249       [ type(geometry),
 250         editable(false),
 251         comment('(X-)geometry for persistent frames')
 252       ]).
 253config(history/subwindow_layout/_Key,
 254       [ type(subwindow_layout),
 255         editable(false),
 256         comment('Sub-window layout for persistent frames')
 257       ]).
 258
 259:- register_config(config).
 260
 261load_geometry_config :-
 262    context_module(M),
 263    ensure_loaded_config(M:_).