1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
|
/* $Id: registry.pl,v 1.4 1999/11/04 10:02:40 jan Exp $
Part of SWI-Prolog
Copyright (c) 1996 University of Amsterdam. All rights reserved.
See ../LICENCE to find out about your rights.
E-mail: jan@swi.psy.uva.nl
Purpose: Provide access to the Win32 registry
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module requires plregtry.ddl, for which the sources are in the
dlldemo directory.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- module(win_registry,
[ registry_get_key/2, % +Path, -Value
registry_get_key/3, % +Path, +Name, -Value
registry_set_key/2, % +Path, +Value
registry_set_key/3, % +Path, +Name, +Value
registry_delete_key/1, % +Path
registry_lookup_key/3, % +Path, +Access, -Key
shell_register_file_type/4, % +Ext, +Type, +Name, +Open
shell_register_dde/6, % +Type, +Action,
% +Service, Topic, +DDECommand
% +IfNotRunning
shell_register_prolog/0
]).
:- load_foreign_library(swi('bin/plregtry')). % load plregtry.ddl
/*******************************
* REGISTER PROLOG *
*******************************/
shell_register_prolog :-
current_prolog_flag(argv, [Me|_]),
concat_atom(['"', Me, '" "%1"'], OpenCommand),
shell_register_file_type(pl, 'prolog.type', 'Prolog Source',
OpenCommand),
shell_register_dde('prolog.type', consult,
prolog, control, 'consult(''%1'')', Me),
shell_register_dde('prolog.type', edit,
prolog, control, 'edit(''%1'')', Me).
/*******************************
* WINDOWS SHELL STUFF *
*******************************/
% shell_register_file_type(+Extension, +Type, +Name, +OpenCommand)
%
% Register an extension to a type. The open command for the type
% is defined and files with this extension will be given Name as
% their description in the explorer. For example:
%
% ?- shell_register_file_type(pl, 'prolog.type', 'Prolog Source',
% '"c:\pl\bin\plwin.exe" "%1"').
shell_register_file_type(Ext, Type, Name, Open) :-
ensure_dot(Ext, DExt),
registry_set_key(classes_root/DExt, Type),
registry_set_key(classes_root/Type, Name),
registry_set_key(classes_root/Type/shell/open/command, Open).
ensure_dot(Ext, Ext) :-
atom_concat('.', _, Ext), !.
ensure_dot(Ext, DExt) :-
atom_concat('.', Ext, DExt).
% Register a DDE command for the type. The example below will
% send DDE_EXECUTE command `consult('<File>') to the service
% prolog, given the topic control.
%
% shell_register_dde('prolog.type', consult,
% prolog, control, 'consult(''%1'')',
% 'c:\pl\bin\plwin.exe -g "edit(''%1'')"').
shell_register_dde(Type, Action, Service, Topic, DDECommand, IfNotRunning) :-
registry_make_key(classes_root/Type/shell/Action/ddeexec,
all_access, EKey),
registry_set_key(classes_root/Type/shell/Action/command, IfNotRunning),
reg_set_value(EKey, '', DDECommand),
registry_set_key(EKey/'Application', Service),
registry_set_key(EKey/ifexec, ''),
registry_set_key(EKey/topic, Topic),
reg_close_key(EKey).
/*******************************
* REGISTRY STUFF *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
In the commands below, Path refers to the path-name of the registry. A
path is a '/' separated description, where the / should be interpreted
as a Prolog operator. For example, classes_root/'prolog.type'/shell. The
components should be atoms.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
% registry_set_key(+Path, [+Name], +Value)
%
% Associate a (string) value with the key described by Path. If
% part of the path does not exist, the required keys will be created.
registry_set_key(Path, Value) :-
registry_set_key(Path, '', Value).
registry_set_key(Path, Name, Value) :-
registry_make_key(Path, write, Key, Close),
reg_set_value(Key, Name, Value),
Close.
% registry_get_key(+Path, [+Name], -Value)
%
% Get the value associated with the given key. If the key does not
% exists, the predicate fails silently.
registry_get_key(Path, Value) :-
registry_get_key(Path, '', Value).
registry_get_key(Path, Name, Value) :-
registry_lookup_key(Path, read, Key, Close),
( reg_get_value(Key, Name, RawVal)
-> Close,
Value = RawVal
; Close,
fail
).
% registry_delete_key(+Path)
%
% Delete the gven key and all its subkeys and values. Note that
% the root-keys cannot be deleted.
registry_delete_key(Parent/Node) :- !,
registry_lookup_key(Parent, all_access, PKey),
( reg_open_key(PKey, Node, all_access, Key)
-> delete_subkeys(Key),
reg_close_key(Key),
reg_delete_key(PKey, Node)
),
reg_close_key(PKey).
delete_subkeys(Parent) :-
reg_subkeys(Parent, Subs),
forall(member(Sub, Subs),
delete_subkey(Parent, Sub)).
delete_subkey(Parent, Sub) :-
reg_open_key(Parent, Sub, all_access, Key),
delete_subkeys(Key),
reg_close_key(Key),
reg_delete_key(Parent, Sub).
% registry_make_key(+Path, +Access, -Key)
%
% Open the given key and create required keys if the path does not
% exist.
registry_make_key(Path, Access, Key) :-
registry_make_key(Path, Access, Key, _).
registry_make_key(A/B, Access, Key, Close) :- !,
registry_make_key(A, Access, Parent, CloseParent),
( reg_open_key(Parent, B, Access, RawKey)
-> true
; reg_create_key(Parent, B, '', [], Access, RawKey)
),
CloseParent,
Close = reg_close_key(RawKey),
Key = RawKey.
registry_make_key(Key, _, Key, true).
% registry_lookup_key(+Path, +Access, -Key)
%
% Open the given key, fail silently if the key doesn't
% exist.
registry_lookup_key(Path, Access, Key) :-
registry_lookup_key(Path, Access, Key, _).
registry_lookup_key(A/B, Access, Key, Close) :- !,
registry_lookup_key(A, Access, Parent, CloseParent),
reg_open_key(Parent, B, Access, RawKey),
CloseParent,
Close = reg_close_key(RawKey),
Key = RawKey.
registry_lookup_key(Key, _, Key, true).
|