1% ----------------------------------------------------------------------
2% BEGIN LICENSE BLOCK
3% Version: CMPL 1.1
4%
5% The contents of this file are subject to the Cisco-style Mozilla Public
6% License Version 1.1 (the "License"); you may not use this file except
7% in compliance with the License.  You may obtain a copy of the License
8% at www.eclipse-clp.org/license.
9%
10% Software distributed under the License is distributed on an "AS IS"
11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
12% the License for the specific language governing rights and limitations
13% under the License.
14%
15% The Original Code is  The ECLiPSe Constraint Logic Programming System.
16% The Initial Developer of the Original Code is  Cisco Systems, Inc.
17% Portions created by the Initial Developer are
18% Copyright (C) 1990-2006 Cisco Systems, Inc.  All Rights Reserved.
19%
20% Contributor(s): ECRC GmbH
21% Contributor(s): IC-Parc, Imperal College London
22%
23% END LICENSE BLOCK
24%
25% System:	ECLiPSe Constraint Logic Programming System
26% Version:	$Id: quintus_util.pl,v 1.1 2008/06/30 17:43:49 jschimpf Exp $
27% ----------------------------------------------------------------------
28
29/*
30 * SEPIA PROLOG SOURCE MODULE
31 *
32 * IDENTIFICATION:	quintus_util.pl
33 *
34 * DESCRIPTION: 	Utility predicates, for user convenience.
35 *
36 * CONTENTS:
37 *
38 */
39
40
41:- module(quintus_util).
42
43:- export q_prompt/2, redef_handler/2, end_compile_handler/2.
44
45%
46% predicate to obtain a Quintus-like prompt
47%
48
49q_prompt(_, Module) :-
50    get_flag(debugging, Dbg),
51    debug_mode(Dbg, Debug),
52    (Debug == nodebug ->
53        (Module == eclipse ->
54            true
55        ;
56            printf(toplevel_output, "[%s]\n", Module)
57        )
58    ;
59
60        put(toplevel_output, 0'[),
61        (Module == eclipse ->
62            true
63        ;
64            printf(toplevel_output, "%s ", Module)
65        ),
66        printf(toplevel_output, "%s]\n", Debug)
67    ),
68    write(toplevel_output, '| ?- '),
69    flush(toplevel_output).
70
71debug_mode(leap, debug).
72debug_mode(nodebug, nodebug).
73debug_mode(creep, trace).
74
75
76
77% A flag to suppress the warnings
78:- setval(pflag, 0).
79
80redef_handler(_, (Proc, OldFile, NewFile)) :-
81    (getval(pflag, 1) ->
82        true
83    ;
84        printf("Procedure %w is being redefined in a different file\n",
85            Proc),
86        printf("    Previous file: %s\n    New file:      %s\n",
87            [OldFile, NewFile]),
88        printf("Do you want to redefine it? (y, n or p) %b", []),
89        tyi(X),
90        (X == 0'y ->
91            writeln(yes)
92        ;
93        X == 0'p ->
94            writeln('suppress warnings'),
95            setval(pflag, 1)
96        ;
97            writeln(no),
98            fail
99        )
100    ).
101
102% At the file end reset the flag
103end_compile_handler(A, B) :-
104    setval(pflag, 0),
105    error(default(A), B).
106
107