View source with raw comments or as raw
    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)).

Save/restore layout of XPCE windows

This library defines the class persistent_frame, a subclass of class frame remembering its geometry and optionally (by default on) the subwindow layout.

This class cooperates with the library(pce_config), a generic package for managing application preferences. It collects the locations of user frames in the file <profile-dir>/Geometry.cnf

Geometry information is stored in the internal configuration DB (see library(pce_config)) if a frame is closed or on exit from the application. The internal database is written to tehe above mentioned file on exit from the application.

Somehow the system must identify the frame to decide which geometry to use. This is done using the <->geometry_key. If not set, this is the classname or, if the class is not subclassed it is the <-label of the frame.

Exploiting this library is very simple, just make your toplevel windows for which you want the geometry remembered a subclass of class persistent_frame rather than class frame. Note that this implies you have to create your frame explitely:

    ...
    new(F, persistent_frame('Pretty Application')),
    send(F, geometry_key, pretty_app),
    send(F, append, new(D, dialog)),
    send(new(V, view), right, D),
    ...

*/

   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    ).
 get_tile_layout(+Tile, -Layout)
Create a Prolog term representing the subwindow (tile) layout. Note that we only save the width/height of resizeable subwindows, leaving the others to the application. This ensures proper behaviour if the application is modified.
  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(_, *).
 has_specifier(+Layout)
See whether there is a specification somewhere, otherwise there is no use storing it.
  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    !.
 apply_tile_layout(+Tile, +Layout)
Apply a previously saved layout description, sending ->width or ->height messages to resizeable tiles.
  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:_)