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)).   39:- require([ context_module/1,
   40	     chain_list/2,
   41	     member/2,
   42	     maplist/3
   43	   ]).

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

*/

   80:- pce_begin_class(persistent_frame, frame, "Frame remembering location").
   81
   82variable(persistent_subwindow_layout, bool := @on, get,
   83         "Remember the layout of the subwindows?").
   84variable(geometry_key,                name*, send,
   85         "Key used to identify this frame").
   86
   87unlink(F) :->
   88    "Save layout and destroy"::
   89    send(F, save_layout),
   90    send_super(F, unlink).
   91
   92create(F) :->
   93    "Create and restore layout"::
   94    send_super(F, create),
   95    ignore(send(F, load_layout)).
   96
   97:- pce_group(config).
   98
   99geometry_key(F, Key:name) :<-
  100    "Name to store geometry"::
  101    (   get(F, slot, geometry_key, Key),
  102        Key \== @nil
  103    ->  true
  104    ;   get(F, class_name, Key),
  105        Key \== persistent_frame
  106    ->  true
  107    ;   get(F, label, Key)
  108    ).
  109
  110save_layout(F) :->
  111    "Save current layout in config DB"::
  112    get(F, geometry, Geometry),
  113    get(F, geometry_key, Key),
  114    set_config(history/geometry/Key, Geometry),
  115    (   get(F, persistent_subwindow_layout, @on),
  116        get(F, tile, RootTile),
  117        get(RootTile, members, Members),
  118        Members \== @nil,
  119        get_tile_layout(RootTile, Layout),
  120        Layout \== *
  121    ->  set_config(history/subwindow_layout/Key, Layout)
  122    ;   true
  123    ).
  124
  125load_layout(F) :->
  126    load_geometry_config,
  127    get(F, geometry_key, Key),
  128    (   get_config(history/geometry/Key, Geometry)
  129    ->  send(F, geometry, Geometry)
  130    ;   true
  131    ),
  132    (   get(F, persistent_subwindow_layout, @on),
  133        get_config(history/subwindow_layout/Key, Layout)
  134    ->  get(F, tile, RootTile),
  135        apply_tile_layout(RootTile, Layout)
  136    ;   true
  137    ).
 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.
  146get_tile_layout(T, layout(Me, SubLayout)) :-
  147    get(T, members, Members),
  148    Members \== @nil,
  149    chain_list(Members, List),
  150    maplist(get_tile_layout, List, SubLayout),
  151    get_this_tile_layout(T, Me),
  152    has_specifier(layout(Me, SubLayout)),
  153    !.
  154get_tile_layout(T, Me) :-
  155    get_this_tile_layout(T, Me).
  156
  157get_this_tile_layout(T, Size) :-
  158    get(T, can_resize, @on),
  159    !,
  160    get(T, area, A),
  161    (   get(T?super, orientation, horizontal)
  162    ->  get(A, width, Size)
  163    ;   get(A, height, Size)
  164    ).
  165get_this_tile_layout(_, *).
 has_specifier(+Layout)
See whether there is a specification somewhere, otherwise there is no use storing it.
  172has_specifier(layout(Size, _)) :-
  173    Size \== *,
  174    !.
  175has_specifier(layout(_, Subs)) :-
  176    !,
  177    has_specifier(Subs).
  178has_specifier(X) :-
  179    integer(X),
  180    !.
  181has_specifier(Subs) :-
  182    member(Sub, Subs),
  183    has_specifier(Sub),
  184    !.
 apply_tile_layout(+Tile, +Layout)
Apply a previously saved layout description, sending ->width or ->height messages to resizeable tiles.
  192apply_tile_layout(T, layout(Me, SubLayout)) :-
  193    !,
  194    apply_this_tile_layout(T, Me),
  195    (   get(T, members, Members),
  196        Members \== @nil
  197    ->  chain_list(Members, List),
  198        maplist(apply_tile_layout, List, SubLayout)
  199    ;   true
  200    ).
  201apply_tile_layout(T, Me) :-
  202    apply_this_tile_layout(T, Me).
  203
  204apply_this_tile_layout(_, *) :- !.
  205apply_this_tile_layout(T, Size) :-
  206    get(T, super, Super),
  207    Super \== @nil,
  208    !,
  209    (   get(Super, orientation, horizontal)
  210    ->  get(T?area, width, W0),
  211        (   Size > W0
  212        ->  get(T, hor_stretch, S)
  213        ;   get(T, hor_shrink, S)
  214        ),
  215        (   S > 0
  216        ->  send(T, width, Size)
  217        ;   true
  218        )
  219    ;   get(T?area, height, H0),
  220        (   Size > H0
  221        ->  get(T, ver_stretch, S)
  222        ;   get(T, ver_shrink, S)
  223        ),
  224        (   S > 0
  225        ->  send(T, height, Size)
  226        ;   true
  227        )
  228    ).
  229apply_this_tile_layout(_, _).
  230
  231:- pce_end_class(persistent_frame).
  232
  233
  234                 /*******************************
  235                 *          EXIT HOOKS          *
  236                 *******************************/
  237
  238:- initialization
  239   send(@pce, exit_message,
  240    message(@display?frames,
  241            for_some,
  242            if(message(@arg1, instance_of, persistent_frame),
  243               message(@arg1, save_layout)))).  244
  245
  246                 /*******************************
  247                 *         CONFIG HOOKS         *
  248                 *******************************/
  249
  250config(config/file,
  251       [ default('Geometry')
  252       ]).
  253config(history/geometry/_Key,
  254       [ type(geometry),
  255         editable(false),
  256         comment('(X-)geometry for persistent frames')
  257       ]).
  258config(history/subwindow_layout/_Key,
  259       [ type(subwindow_layout),
  260         editable(false),
  261         comment('Sub-window layout for persistent frames')
  262       ]).
  263
  264:- register_config(config).  265
  266load_geometry_config :-
  267    context_module(M),
  268    ensure_loaded_config(M:_)