From ba29d58fb21f0f376dd4c09df61b4e1d38cb1226 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Sat, 30 Nov 2024 15:13:42 +1300 Subject: Error/Warning/Fatal added to FLTK.Errors --- doc/fl.html | 88 +++++++++++++++++++++++++++++++++++++++++++++ doc/fl_ask.html | 21 ----------- doc/index.html | 1 + src/c_fl_error.cpp | 87 ++++++++++++++++++++++++++++++++++++++++++++ src/c_fl_error.h | 21 +++++++++++ src/fltk-errors.adb | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/fltk-errors.ads | 39 ++++++++++++++++++++ 7 files changed, 337 insertions(+), 21 deletions(-) create mode 100644 src/c_fl_error.cpp create mode 100644 src/c_fl_error.h create mode 100644 src/fltk-errors.adb create mode 100644 src/fltk-errors.ads diff --git a/doc/fl.html b/doc/fl.html index 3547287..09b1a3b 100644 --- a/doc/fl.html +++ b/doc/fl.html @@ -24,6 +24,11 @@ FLTK + +   + FLTK.Errors + +   FLTK.Event @@ -226,6 +231,89 @@ Mouse_Cursor + +   + Error_Function + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Attributes
+static void (*atclose)(Fl_Window *, void *);
+
Deprecated, set the callback for the Window instead
+static char const * const clipboard_image = "image";
+
 
+static char const * const clipboard_plain_text = "text/plain";
+
 
+static void (*error)(const char *, ...) = ::error;
+
+procedure Default_Error
+       (Message : in String);
+
+Current_Error : Error_Function := Default_Error'Access;
+
(In FLTK.Errors)
+static void (*fatal)(const char *, ...) = ::fatal;
+
+procedure Default_Fatal
+       (Message : in String);
+
+Current_Fatal : Error_Function := Default_Fatal'Access;
+
(In FLTK.Errors)
+static const char * const help = helpmsg + 13;
+
 
+static void (*idle)();
+
Should not be used directly
+static void (*warning)(const char *, ...) = ::warning;
+
+procedure Default_Warning
+       (Message : in String);
+
+Current_Warning : Error_Function := Default_Warning'Access;
+
(In FLTK.Errors)
diff --git a/doc/fl_ask.html b/doc/fl_ask.html index 078c7c8..857f5f5 100644 --- a/doc/fl_ask.html +++ b/doc/fl_ask.html @@ -75,20 +75,6 @@ 
-static void (*Fl::error)(const char *, ...) = ::error;
-
-See FLTK.Errors - - - -
-static void (*Fl::fatal)(const char *, ...) = ::fatal;
-
-See FLTK.Errors - - - -
 const char * fl_cancel = "Cancel";
 
@@ -152,13 +138,6 @@ procedure Set_Yes_String
- -
-static void (*Fl::warning)(const char *, ...) = ::warning;
-
-See FLTK.Errors - - diff --git a/doc/index.html b/doc/index.html index 071dc7c..8a6d4d8 100644 --- a/doc/index.html +++ b/doc/index.html @@ -145,6 +145,7 @@
  • FLTK.Devices.Surfaces.Paged.Printers
  • FLTK.Draw
  • FLTK.Environment
    • +
  • FLTK.Errors
  • FLTK.Event
  • FLTK.Help_Dialogs
  • FLTK.Images
    • diff --git a/src/c_fl_error.cpp b/src/c_fl_error.cpp new file mode 100644 index 0000000..17c45a0 --- /dev/null +++ b/src/c_fl_error.cpp @@ -0,0 +1,87 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include +#include +#include "c_fl_error.h" + + + + +// Exports from Ada + +extern "C" void error_warning_hook(const char * m); +extern "C" void error_error_hook(const char * m); +extern "C" void error_fatal_hook(const char * m); + + +// This is the size used internally in FLTK anyway +const int bsize = 1024; + + +// Some prep needed to convert vargs to a single char* + +void warning_hook_prep(const char * m, ...) { + va_list args; + char buf[bsize]; + va_start(args, m); + vsnprintf(buf, bsize, m, args); + va_end(args); + error_warning_hook(buf); +} + +void error_hook_prep(const char * m, ...) { + va_list args; + char buf[bsize]; + va_start(args, m); + vsnprintf(buf, bsize, m, args); + va_end(args); + error_error_hook(buf); +} + +void fatal_hook_prep(const char * m, ...) { + va_list args; + char buf[bsize]; + va_start(args, m); + vsnprintf(buf, bsize, m, args); + va_end(args); + error_fatal_hook(buf); +} + + + + +// Original function pointers + +void (*original_warning)(const char *, ...) = Fl::warning; +void (*original_error)(const char *, ...) = Fl::error; +void (*original_fatal)(const char *, ...) = Fl::fatal; + + +void fl_error_default_warning(const char * m) { + (*original_warning)(m); +} + +void fl_error_default_error(const char * m) { + (*original_error)(m); +} + +void fl_error_default_fatal(const char * m) { + (*original_fatal)(m); +} + + + + +// Tying it all together + +void fl_error_set_hooks() { + Fl::warning = &warning_hook_prep; + Fl::error = &error_hook_prep; + Fl::fatal = &fatal_hook_prep; +} + + diff --git a/src/c_fl_error.h b/src/c_fl_error.h new file mode 100644 index 0000000..263a42b --- /dev/null +++ b/src/c_fl_error.h @@ -0,0 +1,21 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_ERROR_GUARD +#define FL_ERROR_GUARD + + +extern "C" void fl_error_default_warning(const char * m); +extern "C" void fl_error_default_error(const char * m); +extern "C" void fl_error_default_fatal(const char * m); + + +extern "C" void fl_error_set_hooks(); + + +#endif + + diff --git a/src/fltk-errors.adb b/src/fltk-errors.adb new file mode 100644 index 0000000..ef31002 --- /dev/null +++ b/src/fltk-errors.adb @@ -0,0 +1,101 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + + +package body FLTK.Errors is + + + procedure fl_error_default_warning + (M : in Interfaces.C.char_array); + pragma Import (C, fl_error_default_warning, "fl_error_default_warning"); + pragma Inline (fl_error_default_warning); + + procedure fl_error_default_error + (M : in Interfaces.C.char_array); + pragma Import (C, fl_error_default_error, "fl_error_default_error"); + pragma Inline (fl_error_default_error); + + procedure fl_error_default_fatal + (M : in Interfaces.C.char_array); + pragma Import (C, fl_error_default_fatal, "fl_error_default_fatal"); + pragma Inline (fl_error_default_fatal); + + procedure fl_error_set_hooks; + pragma Import (C, fl_error_set_hooks, "fl_error_set_hooks"); + pragma Inline (fl_error_set_hooks); + + + + + procedure Warning_Hook + (C_Mess : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, Warning_Hook, "error_warning_hook"); + + procedure Warning_Hook + (C_Mess : in Interfaces.C.Strings.chars_ptr) is + begin + Current_Warning (Interfaces.C.Strings.Value (C_Mess)); + end Warning_Hook; + + + procedure Error_Hook + (C_Mess : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, Error_Hook, "error_error_hook"); + + procedure Error_Hook + (C_Mess : in Interfaces.C.Strings.chars_ptr) is + begin + Current_Error (Interfaces.C.Strings.Value (C_Mess)); + end Error_Hook; + + + procedure Fatal_Hook + (C_Mess : in Interfaces.C.Strings.chars_ptr); + pragma Export (C, Fatal_Hook, "error_fatal_hook"); + + procedure Fatal_Hook + (C_Mess : in Interfaces.C.Strings.chars_ptr) is + begin + Current_Fatal (Interfaces.C.Strings.Value (C_Mess)); + end Fatal_Hook; + + + + + procedure Default_Warning + (Message : in String) is + begin + fl_error_default_warning (Interfaces.C.To_C (Message)); + end Default_Warning; + + + procedure Default_Error + (Message : in String) is + begin + fl_error_default_error (Interfaces.C.To_C (Message)); + end Default_Error; + + + procedure Default_Fatal + (Message : in String) is + begin + fl_error_default_fatal (Interfaces.C.To_C (Message)); + end Default_Fatal; + + +begin + + + fl_error_set_hooks; + + +end FLTK.Errors; + + diff --git a/src/fltk-errors.ads b/src/fltk-errors.ads new file mode 100644 index 0000000..6cdea54 --- /dev/null +++ b/src/fltk-errors.ads @@ -0,0 +1,39 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Errors is + + + type Error_Function is not null access procedure + (Message : in String); + + + procedure Default_Warning + (Message : in String); + + procedure Default_Error + (Message : in String); + + procedure Default_Fatal + (Message : in String); + + + Current_Warning : Error_Function := Default_Warning'Access; + Current_Error : Error_Function := Default_Error'Access; + Current_Fatal : Error_Function := Default_Fatal'Access; + + +private + + + pragma Inline (Default_Warning); + pragma Inline (Default_Error); + pragma Inline (Default_Fatal); + + +end FLTK.Errors; + + -- cgit