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/packages/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	   ]).   44
   45/** <module> Save/restore layout of XPCE windows
   46
   47This library defines the class  persistent_frame,   a  subclass of class
   48frame remembering its geometry  and  optionally   (by  default  on)  the
   49subwindow layout.
   50
   51This class cooperates with the   library(pce_config),  a generic package
   52for managing application preferences.  It collects the locations of user
   53frames in the file <profile-dir>/Geometry.cnf
   54
   55Geometry information is stored in  the   internal  configuration DB (see
   56library(pce_config))  if  a  frame  is  closed   or  on  exit  from  the
   57application. The internal database is written   to  tehe above mentioned
   58file on exit from the application.
   59
   60Somehow the system must identify the frame   to decide which geometry to
   61use. This is done using the  <->geometry_key.   If  not set, this is the
   62classname or, if the class is not subclassed   it  is the <-label of the
   63frame.
   64
   65Exploiting this library is very simple,  just make your toplevel windows
   66for  which  you  want  the  geometry  remembered  a  subclass  of  class
   67persistent_frame rather than class frame.  Note   that  this implies you
   68have to create your frame explitely:
   69
   70    ==
   71        ...
   72        new(F, persistent_frame('Pretty Application')),
   73        send(F, geometry_key, pretty_app),
   74        send(F, append, new(D, dialog)),
   75        send(new(V, view), right, D),
   76        ...
   77    ==
   78*/
   79
   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    ).
  138
  139%!  get_tile_layout(+Tile, -Layout)
  140%
  141%   Create a Prolog term representing the subwindow (tile) layout.
  142%   Note that we only save the width/height of resizeable subwindows,
  143%   leaving the others to the application.  This ensures proper behaviour
  144%   if the application is modified.
  145
  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(_, *).
  166
  167%!  has_specifier(+Layout)
  168%
  169%   See whether there is a specification somewhere, otherwise there
  170%   is no use storing it.
  171
  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    !.
  185
  186
  187%!  apply_tile_layout(+Tile, +Layout)
  188%
  189%   Apply a previously saved layout description, sending ->width
  190%   or ->height messages to resizeable tiles.
  191
  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:_)