← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to libguile/deprecation.c

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libguile/deprecation.c
 
1
/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
 
2
 * 
 
3
 * This library is free software; you can redistribute it and/or
 
4
 * modify it under the terms of the GNU Lesser General Public
 
5
 * License as published by the Free Software Foundation; either
 
6
 * version 2.1 of the License, or (at your option) any later version.
 
7
 *
 
8
 * This library is distributed in the hope that it will be useful,
 
9
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
11
 * Lesser General Public License for more details.
 
12
 *
 
13
 * You should have received a copy of the GNU Lesser General Public
 
14
 * License along with this library; if not, write to the Free Software
 
15
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
16
 */
 
17
 
 
18
 
 
19
 
 
20
#if HAVE_CONFIG_H
 
21
#  include <config.h>
 
22
#endif
 
23
 
 
24
#include <stdio.h>
 
25
#include <string.h>
 
26
#include <stdarg.h>
 
27
 
 
28
#include "libguile/_scm.h"
 
29
 
 
30
#include "libguile/deprecation.h"
 
31
#include "libguile/strings.h"
 
32
#include "libguile/ports.h"
 
33
 
 
34
/* Windows defines. */
 
35
#ifdef __MINGW32__
 
36
#define vsnprintf _vsnprintf
 
37
#endif
 
38
 
 
39
 
 
40
 
 
41
#if (SCM_ENABLE_DEPRECATED == 1)
 
42
 
 
43
struct issued_warning {
 
44
  struct issued_warning *prev;
 
45
  const char *message;
 
46
};
 
47
 
 
48
static struct issued_warning *issued_warnings;
 
49
static int print_summary = 0;
 
50
 
 
51
void
 
52
scm_c_issue_deprecation_warning (const char *msg)
 
53
{
 
54
  if (!SCM_WARN_DEPRECATED)
 
55
    print_summary = 1;
 
56
  else
 
57
    {
 
58
      struct issued_warning *iw;
 
59
      for (iw = issued_warnings; iw; iw = iw->prev)
 
60
        if (!strcmp (iw->message, msg))
 
61
          return;
 
62
      if (scm_gc_running_p)
 
63
        fprintf (stderr, "%s\n", msg);
 
64
      else
 
65
        {
 
66
          scm_puts (msg, scm_current_error_port ());
 
67
          scm_newline (scm_current_error_port ());
 
68
        }
 
69
      msg = strdup (msg);
 
70
      iw = malloc (sizeof (struct issued_warning));
 
71
      if (msg == NULL || iw == NULL)
 
72
        return;
 
73
      iw->message = msg;
 
74
      iw->prev = issued_warnings;
 
75
      issued_warnings = iw;
 
76
    }
 
77
}
 
78
 
 
79
void
 
80
scm_c_issue_deprecation_warning_fmt (const char *msg, ...)
 
81
{
 
82
  va_list ap;
 
83
  char buf[512];
 
84
 
 
85
  va_start (ap, msg);
 
86
  vsnprintf (buf, 511, msg, ap);
 
87
  va_end (ap);
 
88
  buf[511] = '\0';
 
89
  scm_c_issue_deprecation_warning (buf);
 
90
}
 
91
 
 
92
SCM_DEFINE(scm_issue_deprecation_warning,
 
93
           "issue-deprecation-warning", 0, 0, 1, 
 
94
           (SCM msgs),
 
95
           "Output @var{msgs} to @code{(current-error-port)} when this "
 
96
           "is the first call to @code{issue-deprecation-warning} with "
 
97
           "this specific @var{msgs}.  Do nothing otherwise. "
 
98
           "The argument @var{msgs} should be a list of strings; "
 
99
           "they are printed in turn, each one followed by a newline.")
 
100
#define FUNC_NAME s_scm_issue_deprecation_warning
 
101
{
 
102
  if (!SCM_WARN_DEPRECATED)
 
103
    print_summary = 1;
 
104
  else
 
105
    {
 
106
      SCM nl = scm_from_locale_string ("\n");
 
107
      SCM msgs_nl = SCM_EOL;
 
108
      char *c_msgs;
 
109
      while (scm_is_pair (msgs))
 
110
        {
 
111
          if (msgs_nl != SCM_EOL)
 
112
            msgs_nl = scm_cons (nl, msgs_nl);
 
113
          msgs_nl = scm_cons (SCM_CAR (msgs), msgs_nl);
 
114
          msgs = SCM_CDR (msgs);
 
115
        }
 
116
      msgs_nl = scm_string_append (scm_reverse_x (msgs_nl, SCM_EOL));
 
117
      c_msgs = scm_to_locale_string (msgs_nl);
 
118
      scm_c_issue_deprecation_warning (c_msgs);
 
119
      free (c_msgs);
 
120
    }
 
121
  return SCM_UNSPECIFIED;
 
122
}
 
123
#undef FUNC_NAME
 
124
 
 
125
static void
 
126
print_deprecation_summary (void)
 
127
{
 
128
  if (print_summary)
 
129
    {
 
130
      fputs ("\n"
 
131
             "Some deprecated features have been used.  Set the environment\n"
 
132
             "variable GUILE_WARN_DEPRECATED to \"detailed\" and rerun the\n"
 
133
             "program to get more information.  Set it to \"no\" to suppress\n"
 
134
             "this message.\n", stderr);
 
135
    }
 
136
}
 
137
 
 
138
#endif /* SCM_ENABLE_DEPRECATED == 1 */
 
139
 
 
140
SCM_DEFINE(scm_include_deprecated_features,
 
141
           "include-deprecated-features", 0, 0, 0,
 
142
           (),
 
143
           "Return @code{#t} iff deprecated features should be included "
 
144
           "in public interfaces.")
 
145
#define FUNC_NAME s_scm_include_deprecated_features
 
146
{
 
147
  return scm_from_bool (SCM_ENABLE_DEPRECATED == 1);
 
148
}
 
149
#undef FUNC_NAME
 
150
 
 
151
 
 
152
 
 
153
 
 
154
void
 
155
scm_init_deprecation ()
 
156
{
 
157
#if (SCM_ENABLE_DEPRECATED == 1)
 
158
  const char *level = getenv ("GUILE_WARN_DEPRECATED");
 
159
  if (level == NULL)
 
160
    level = SCM_WARN_DEPRECATED_DEFAULT;
 
161
  if (!strcmp (level, "detailed"))
 
162
    SCM_WARN_DEPRECATED = 1;
 
163
  else if (!strcmp (level, "no"))
 
164
    SCM_WARN_DEPRECATED = 0;
 
165
  else
 
166
    {
 
167
      SCM_WARN_DEPRECATED = 0;
 
168
      atexit (print_deprecation_summary);
 
169
    }
 
170
#endif
 
171
#include "libguile/deprecation.x"
 
172
}
 
173
 
 
174
/*
 
175
  Local Variables:
 
176
  c-file-style: "gnu"
 
177
  End: */