summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/fl_browser.html763
-rw-r--r--doc/index.html3
-rw-r--r--progress.txt2
-rw-r--r--src/c_fl_browser.cpp509
-rw-r--r--src/c_fl_browser.h118
-rw-r--r--src/c_fl_error.cpp11
-rw-r--r--src/c_fl_error.h3
-rw-r--r--src/fltk-widgets-groups-browsers-textline.adb1255
-rw-r--r--src/fltk-widgets-groups-browsers-textline.ads427
-rw-r--r--src/fltk-widgets-groups-browsers.adb218
-rw-r--r--src/fltk-widgets-groups-browsers.ads48
11 files changed, 3308 insertions, 49 deletions
diff --git a/doc/fl_browser.html b/doc/fl_browser.html
new file mode 100644
index 0000000..f4168a9
--- /dev/null
+++ b/doc/fl_browser.html
@@ -0,0 +1,763 @@
+<!DOCTYPE html>
+
+<html lang="en">
+ <head>
+ <meta charset="utf-8">
+ <title>Fl_Browser Binding Map</title>
+ <link href="map.css" rel="stylesheet">
+ </head>
+
+ <body>
+
+
+<h2>Fl_Browser Binding Map</h2>
+
+
+<a href="index.html">Back to Index</a>
+
+
+<table class="package">
+ <tr><th colspan="2">Package name</th></tr>
+
+ <tr>
+ <td>Fl_Browser</td>
+ <td>FLTK.Widgets.Groups.Browsers.Textline</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Types</th></tr>
+
+ <tr>
+ <td>Fl_Browser</td>
+ <td>Textline_Browser</td>
+ </tr>
+
+ <tr>
+ <td>&nbsp;</td>
+ <td>Textline_Browser_Reference</td>
+ </tr>
+
+ <tr>
+ <td>Fl_Line_Position</td>
+ <td>Line_Position</td>
+ </tr>
+
+ <tr>
+ <td>const int *</td>
+ <td>Column_Widths</td>
+ </tr>
+
+</table>
+
+
+
+<table class="type">
+ <tr><th colspan="2">Errors</th></tr>
+
+ <tr>
+ <td>int</td>
+ <td>Browser_Load_Error</td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Constructors</th></tr>
+
+ <tr>
+<td><pre>
+Fl_Browser(int X, int Y, int W, int H, const char *L=0);
+</pre></td>
+<td><pre>
+function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Textline_Browser;
+</pre></td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+void add(const char *newtext, void *d=0);
+</pre></td>
+<td><pre>
+procedure Add
+ (This : in out Textline_Browser;
+ Text : in String);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void bottomline(int line);
+</pre></td>
+<td><pre>
+procedure Set_Bottom_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void clear();
+</pre></td>
+<td><pre>
+procedure Clear
+ (This : in out Textline_Browser);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+char column_char() const;
+</pre></td>
+<td><pre>
+function Get_Column_Character
+ (This : in Textline_Browser)
+ return Character;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void column_char(char c);
+</pre></td>
+<td><pre>
+procedure Set_Column_Character
+ (This : in out Textline_Browser;
+ Value : in Character);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+const int * column_widths() const;
+</pre></td>
+<td><pre>
+function Get_Column_Widths
+ (This : in Textline_Browser)
+ return Column_Widths;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void column_widths(const int *arr);
+</pre></td>
+<td><pre>
+procedure Set_Column_Widths
+ (This : in out Textline_Browser;
+ Widths : in Column_Widths);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void * data(int line) const;
+</pre></td>
+<td>Not used</td>
+ </tr>
+
+ <tr>
+<td><pre>
+void data(int line, void *d);
+</pre></td>
+<td>Not used</td>
+ </tr>
+
+ <tr>
+<td><pre>
+void display(int line, int val=1);
+</pre></td>
+<td>Deprecated, see show / Show_Line and hide / Hide_Line</td>
+ </tr>
+
+ <tr>
+<td><pre>
+int displayed(int line) const;
+</pre></td>
+<td><pre>
+function Is_Displayed
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+char format_char() const;
+</pre></td>
+<td><pre>
+function Get_Format_Character
+ (This : in Textline_Browser)
+ return Character;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void format_char(char c);
+</pre></td>
+<td><pre>
+procedure Set_Format_Character
+ (This : in out Textline_Browser;
+ Value : in Character);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void hide();
+</pre></td>
+<td><pre>
+procedure Hide
+ (This : in out Textline_Browser);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void hide(int line);
+</pre></td>
+<td><pre>
+procedure Hide_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+Fl_Image * icon(int line) const;
+</pre></td>
+<td><pre>
+function Has_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+
+function Get_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return FLTK.Images.Image_Reference;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void icon(int line, Fl_Image *icon);
+</pre></td>
+<td><pre>
+procedure Set_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Icon : in FLTK.Images.Image'Class);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void insert(int line, const char *newtext, void *d=0);
+</pre></td>
+<td><pre>
+procedure Insert
+ (This : in out Textline_Browser;
+ Above : in Positive;
+ Text : in String);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void lineposition(int line, Fl_Line_Position pos);
+</pre></td>
+<td><pre>
+procedure Set_Line_Position
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Place : in Line_Position);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int load(const char *filename);
+</pre></td>
+<td><pre>
+procedure Load
+ (This : in out Textline_Browser;
+ File : in String);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void make_visible(int line);
+</pre></td>
+<td><pre>
+procedure Make_Visible
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void middleline(int line);
+</pre></td>
+<td><pre>
+procedure Set_Middle_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void move(int to, int from);
+</pre></td>
+<td><pre>
+procedure Move
+ (This : in out Textline_Browser;
+ From, To : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void remove(int line);
+</pre></td>
+<td><pre>
+procedure Remove
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void remove_icon(int line);
+</pre></td>
+<td><pre>
+procedure Remove_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void replace(int a, const char *b);
+</pre></td>
+<td>Deprecated, see text / Set_Line_Text</td>
+ </tr>
+
+ <tr>
+<td><pre>
+int select(int line, int val=1);
+</pre></td>
+<td><pre>
+function Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True)
+ return Boolean;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int selected(int line) const;
+</pre></td>
+<td><pre>
+function Is_Selected
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void show();
+</pre></td>
+<td><pre>
+procedure Show
+ (This : in out Textline_Browser);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void show(int line);
+</pre></td>
+<td><pre>
+procedure Show_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int size() const;
+</pre></td>
+<td><pre>
+function Number_Of_Lines
+ (This : in Textline_Browser)
+ return Natural;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void size(int W, int H);
+</pre></td>
+<td>Falls through to Fl_Widget::size(int, int) anyway so binding unnecessary</td>
+ </tr>
+
+ <tr>
+<td><pre>
+void swap(int a, int b);
+</pre></td>
+<td><pre>
+procedure Swap
+ (This : in out Textline_Browser;
+ A, B : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+const char * text(int line) const;
+</pre></td>
+<td><pre>
+function Get_Line_Text
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return String;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void text(int line, const char *newtext);
+</pre></td>
+<td><pre>
+procedure Set_Line_Text
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Text : in String);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+Fl_Fontsize textsize() const;
+</pre></td>
+<td><pre>
+function Get_Text_Size
+ (This : in Textline_Browser)
+ return Font_Size;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void textsize(Fl_Fontsize newSize);
+</pre></td>
+<td><pre>
+procedure Set_Text_Size
+ (This : in out Textline_Browser;
+ Size : in Font_Size);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int topline() const;
+</pre></td>
+<td><pre>
+function Get_Top_Line
+ (This : in Textline_Browser)
+ return Positive;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void topline(int line);
+</pre></td>
+<td><pre>
+procedure Set_Top_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int value() const;
+</pre></td>
+<td><pre>
+function Selected_Index
+ (This : in Textline_Browser)
+ return Natural;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void value(int line);
+</pre></td>
+<td><pre>
+procedure Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int visible(int line) const;
+</pre></td>
+<td><pre>
+function Is_Visible
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+</pre></td>
+ </tr>
+
+</table>
+
+
+
+<table class="function">
+ <tr><th colspan="2">Protected Functions and Procedures</th></tr>
+
+ <tr>
+<td><pre>
+FL_BLINE * _remove(int line);
+</pre></td>
+<td>Intentionally left unbound</td>
+ </tr>
+
+ <tr>
+<td><pre>
+FL_BLINE * find_line(int line) const;
+</pre></td>
+<td>Intentionally left unbound</td>
+ </tr>
+
+ <tr>
+<td><pre>
+int full_height() const;
+</pre></td>
+<td><pre>
+function Full_List_Height
+ (This : in Textline_Browser)
+ return Integer;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int incr_height() const;
+</pre></td>
+<td><pre>
+function Average_Item_Height
+ (This : in Textline_Browser)
+ return Integer;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void insert(int line, FL_BLINE *item);
+</pre></td>
+<td>Intentionally left unbound</td>
+ </tr>
+
+ <tr>
+<td><pre>
+void * item_at(int line) const;
+</pre></td>
+<td><pre>
+function Item_At
+ (This : in Textline_Browser;
+ Index : in Positive)
+ return Item_Cursor;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void item_draw(void *item, int X, int Y, int W, int H) const;
+</pre></td>
+<td><pre>
+procedure Item_Draw
+ (This : in Textline_Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void * item_first() const;
+</pre></td>
+<td><pre>
+function Item_First
+ (This : in Textline_Browser)
+ return Item_Cursor;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int item_height(void *item) const;
+</pre></td>
+<td><pre>
+function Item_Height
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void * item_last() const;
+</pre></td>
+<td><pre>
+function Item_Last
+ (This : in Textline_Browser)
+ return Item_Cursor;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void * item_next(void *item) const;
+</pre></td>
+<td><pre>
+function Item_Next
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void * item_prev(void *item) const;
+</pre></td>
+<td><pre>
+function Item_Previous
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void item_select(void *item, int val);
+</pre></td>
+<td><pre>
+procedure Item_Select
+ (This : in out Textline_Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int item_selected(void *item) const;
+</pre></td>
+<td><pre>
+function Item_Selected
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Boolean;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void item_swap(void *a, void *b);
+</pre></td>
+<td><pre>
+procedure Item_Swap
+ (This : in out Textline_Browser;
+ A, B : in Item_Cursor);
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+const char * item_text(void *item) const;
+</pre></td>
+<td><pre>
+function Item_Text
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return String;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int item_width(void *item) const;
+</pre></td>
+<td><pre>
+function Item_Width
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+int lineno(void *item) const;
+</pre></td>
+<td><pre>
+function Line_Number
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Natural;
+</pre></td>
+ </tr>
+
+ <tr>
+<td><pre>
+void swap(FL_BLINE *a, FL_BLINE *b);
+</pre></td>
+<td>Intentionally left unbound</td>
+ </tr>
+
+</table>
+
+
+ </body>
+</html>
+
diff --git a/doc/index.html b/doc/index.html
index d5a7183..16870d0 100644
--- a/doc/index.html
+++ b/doc/index.html
@@ -24,7 +24,7 @@
<li><a href="fl_bitmap.html">Fl_Bitmap</a></li>
<li><a href="fl_bmp_image.html">Fl_BMP_Image</a></li>
<li><a href="fl_box.html">Fl_Box</a></li>
- <li>Fl_Browser</li>
+ <li><a href="fl_browser.html">Fl_Browser</a></li>
<li><a href="fl_browser_.html">Fl_Browser_</a></li>
<li><a href="fl_button.html">Fl_Button</a></li>
<li><a href="fl_cairo_window.html">Fl_Cairo_Window</a></li>
@@ -189,6 +189,7 @@
<li><a href="fl_group.html">FLTK.Widgets.Groups</a></li>
<li><a href="fl_browser_.html">FLTK.Widgets.Groups.Browsers</a></li>
<li><a href="fl_check_browser.html">FLTK.Widgets.Groups.Browsers.Check</a></li>
+ <li><a href="fl_browser.html">FLTK.Widgets.Groups.Browsers.Textline</a></li>
<li><a href="fl_color_chooser.html">FLTK.Widgets.Groups.Color_Choosers</a></li>
<li><a href="fl_help_view.html">FLTK.Widgets.Groups.Help_Views</a></li>
<li><a href="fl_input_choice.html">FLTK.Widgets.Groups.Input_Choices</a></li>
diff --git a/progress.txt b/progress.txt
index 00daa1a..0776d3f 100644
--- a/progress.txt
+++ b/progress.txt
@@ -72,6 +72,7 @@ FLTK.Widgets.Clocks.Updated.Round
FLTK.Widgets.Groups
FLTK.Widgets.Groups.Browsers
FLTK.Widgets.Groups.Browsers.Check
+FLTK.Widgets.Groups.Browsers.Textline
FLTK.Widgets.Groups.Color_Choosers
FLTK.Widgets.Groups.Help_Views
FLTK.Widgets.Groups.Input_Choices
@@ -141,7 +142,6 @@ FLTK.Devices.Surfaces (incomplete API, otherwise polished)
To-Do:
-Fl_Browser
Fl_Display_Device
Fl_File_Browser
Fl_Glut_Window
diff --git a/src/c_fl_browser.cpp b/src/c_fl_browser.cpp
new file mode 100644
index 0000000..ba74715
--- /dev/null
+++ b/src/c_fl_browser.cpp
@@ -0,0 +1,509 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#include <FL/Fl_Browser.H>
+#include <FL/Fl_Image.H>
+#include "c_fl_browser.h"
+
+
+
+
+// Exports from Ada
+
+extern "C" int browser_full_width_hook(void * b);
+extern "C" int browser_full_height_hook(void * b);
+extern "C" int browser_incr_height_hook(void * b);
+extern "C" int browser_item_quick_height_hook(void * b, void * i);
+
+extern "C" int browser_item_width_hook(void * b, void * i);
+extern "C" int browser_item_height_hook(void * b, void * i);
+extern "C" void * browser_item_first_hook(void * b);
+extern "C" void * browser_item_last_hook(void * b);
+extern "C" void * browser_item_next_hook(void * b, void * i);
+extern "C" void * browser_item_prev_hook(void * b, void * i);
+extern "C" void * browser_item_at_hook(void * b, int n);
+extern "C" void browser_item_select_hook(void * b, void * i, int s);
+extern "C" int browser_item_selected_hook(void * b, void * i);
+extern "C" void browser_item_swap_hook(void * b, void * one, void * two);
+extern "C" const char * browser_item_text_hook(void * b, void * i);
+extern "C" void browser_item_draw_hook(void * b, void * i, int x, int y, int w, int h);
+
+extern "C" void widget_draw_hook(void * ud);
+extern "C" int widget_handle_hook(void * ud, int e);
+
+
+
+
+// Attaching all relevant hooks and friends
+
+class My_Browser : public Fl_Browser {
+public:
+ using Fl_Browser::Fl_Browser;
+
+ friend int fl_browser_item_width(BROWSER b, void * item);
+ friend int fl_browser_item_height(BROWSER b, void * item);
+ friend void * fl_browser_item_first(BROWSER b);
+ friend void * fl_browser_item_last(BROWSER b);
+ friend void * fl_browser_item_next(BROWSER b, void * item);
+ friend void * fl_browser_item_prev(BROWSER b, void * item);
+ friend void * fl_browser_item_at(BROWSER b, int index);
+ friend void fl_browser_item_select(BROWSER b, void * item, int val);
+ friend int fl_browser_item_selected(BROWSER b, void * item);
+ friend void fl_browser_item_swap(BROWSER b, void * x, void * y);
+ friend const char * fl_browser_item_text(BROWSER b, void * item);
+ friend void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h);
+
+ friend int fl_browser_lineno(BROWSER b, void * item);
+
+ friend void * fl_browser_selection(BROWSER c);
+ friend int fl_browser_displayed2(BROWSER c, void * i);
+ friend void * fl_browser_find_item(BROWSER c, int y);
+ friend void * fl_browser_top(BROWSER c);
+
+ friend void fl_browser_bbox(BROWSER c, int &x, int &y, int &w, int &h);
+ friend int fl_browser_leftedge(BROWSER c);
+ friend void fl_browser_redraw_line(BROWSER c, void * i);
+ friend void fl_browser_redraw_lines(BROWSER c);
+
+ friend int fl_browser_full_width(BROWSER c);
+ friend int fl_browser_full_height(BROWSER c);
+ friend int fl_browser_incr_height(BROWSER c);
+ friend int fl_browser_item_quick_height(BROWSER c, void * i);
+
+ friend void fl_browser_new_list(BROWSER b);
+ friend void fl_browser_inserting(BROWSER b, void * a1, void * a2);
+ friend void fl_browser_deleting(BROWSER b, void * item);
+ friend void fl_browser_replacing(BROWSER b, void * a1, void * a2);
+ friend void fl_browser_swapping(BROWSER b, void * a1, void * a2);
+
+ friend void fl_browser_draw(BROWSER b);
+
+ int handle(int e);
+
+protected:
+ int full_width() const;
+ int full_height() const;
+ int incr_height() const;
+ int item_quick_height(void * item) const;
+
+ int item_width(void * item) const;
+ int item_height(void * item) const;
+ void * item_first() const;
+ void * item_last() const;
+ void * item_next(void * item) const;
+ void * item_prev(void * item) const;
+ void * item_at(int index) const;
+ void item_select(void * item, int val=1);
+ int item_selected(void * item) const;
+ void item_swap(void * a, void * b);
+ const char * item_text(void * item) const;
+ void item_draw(void * item, int x, int y, int w, int h) const;
+
+ void draw();
+};
+
+
+int My_Browser::full_width() const {
+ return browser_full_width_hook(this->user_data());
+}
+
+int My_Browser::full_height() const {
+ return browser_full_height_hook(this->user_data());
+}
+
+int My_Browser::incr_height() const {
+ return browser_incr_height_hook(this->user_data());
+}
+
+int My_Browser::item_quick_height(void * item) const {
+ return browser_item_quick_height_hook(this->user_data(), item);
+}
+
+
+int My_Browser::item_width(void * item) const {
+ return browser_item_width_hook(this->user_data(), item);
+}
+
+int My_Browser::item_height(void * item) const {
+ return browser_item_height_hook(this->user_data(), item);
+}
+
+void * My_Browser::item_first() const {
+ return browser_item_first_hook(this->user_data());
+}
+
+void * My_Browser::item_last() const {
+ return browser_item_last_hook(this->user_data());
+}
+
+void * My_Browser::item_next(void * item) const {
+ return browser_item_next_hook(this->user_data(), item);
+}
+
+void * My_Browser::item_prev(void * item) const {
+ return browser_item_prev_hook(this->user_data(), item);
+}
+
+void * My_Browser::item_at(int index) const {
+ return browser_item_at_hook(this->user_data(), index);
+}
+
+void My_Browser::item_select(void * item, int val) {
+ browser_item_select_hook(this->user_data(), item, val);
+}
+
+int My_Browser::item_selected(void * item) const {
+ return browser_item_selected_hook(this->user_data(), item);
+}
+
+void My_Browser::item_swap(void * a, void * b) {
+ browser_item_swap_hook(this->user_data(), a, b);
+}
+
+const char * My_Browser::item_text(void * item) const {
+ return browser_item_text_hook(this->user_data(), item);
+}
+
+void My_Browser::item_draw(void * item, int x, int y, int w, int h) const {
+ browser_item_draw_hook(this->user_data(), item, x, y, w, h);
+}
+
+
+void My_Browser::draw() {
+ widget_draw_hook(this->user_data());
+}
+
+int My_Browser::handle(int e) {
+ return widget_handle_hook(this->user_data(), e);
+}
+
+
+
+
+// Flattened C API begins here
+
+BROWSER new_fl_browser(int x, int y, int w, int h, char * label) {
+ My_Browser *b = new My_Browser(x, y, w, h, label);
+ return b;
+}
+
+void free_fl_browser(BROWSER b) {
+ delete reinterpret_cast<My_Browser*>(b);
+}
+
+
+
+
+void fl_browser_add(BROWSER b, const char * text, void * d) {
+ reinterpret_cast<Fl_Browser*>(b)->add(text, d);
+}
+
+void fl_browser_insert(BROWSER b, int line, const char * text, void * d) {
+ reinterpret_cast<Fl_Browser*>(b)->insert(line, text, d);
+}
+
+void fl_browser_move(BROWSER b, int to, int from) {
+ reinterpret_cast<Fl_Browser*>(b)->move(to, from);
+}
+
+void fl_browser_swap(BROWSER b, int x, int y) {
+ reinterpret_cast<Fl_Browser*>(b)->swap(x, y);
+}
+
+void fl_browser_remove(BROWSER b, int line) {
+ reinterpret_cast<Fl_Browser*>(b)->remove(line);
+}
+
+void fl_browser_clear(BROWSER b) {
+ reinterpret_cast<Fl_Browser*>(b)->clear();
+}
+
+int fl_browser_size(BROWSER b) {
+ return reinterpret_cast<Fl_Browser*>(b)->size();
+}
+
+
+
+
+int fl_browser_load(BROWSER b, const char * f) {
+ return reinterpret_cast<Fl_Browser*>(b)->load(f);
+}
+
+const char * fl_browser_get_text(BROWSER b, int line) {
+ return reinterpret_cast<Fl_Browser*>(b)->text(line);
+}
+
+void fl_browser_set_text(BROWSER b, int line, const char * text) {
+ reinterpret_cast<Fl_Browser*>(b)->text(line, text);
+}
+
+int fl_browser_get_textsize(BROWSER b) {
+ return reinterpret_cast<Fl_Browser*>(b)->textsize();
+}
+
+void fl_browser_set_textsize(BROWSER b, int size) {
+ reinterpret_cast<Fl_Browser*>(b)->textsize(size);
+}
+
+
+
+
+char fl_browser_get_column_char(BROWSER b) {
+ return reinterpret_cast<Fl_Browser*>(b)->column_char();
+}
+
+void fl_browser_set_column_char(BROWSER b, char c) {
+ reinterpret_cast<Fl_Browser*>(b)->column_char(c);
+}
+
+void fl_browser_set_column_widths(BROWSER b, void * w) {
+ reinterpret_cast<Fl_Browser*>(b)->column_widths(reinterpret_cast<const int *>(w));
+}
+
+char fl_browser_get_format_char(BROWSER b) {
+ return reinterpret_cast<Fl_Browser*>(b)->format_char();
+}
+
+void fl_browser_set_format_char(BROWSER b, char c) {
+ reinterpret_cast<Fl_Browser*>(b)->format_char(c);
+}
+
+
+
+
+int fl_browser_get_topline(BROWSER b) {
+ return reinterpret_cast<Fl_Browser*>(b)->topline();
+}
+
+void fl_browser_set_topline(BROWSER b, int line) {
+ reinterpret_cast<Fl_Browser*>(b)->topline(line);
+}
+
+void fl_browser_middleline(BROWSER b, int line) {
+ reinterpret_cast<Fl_Browser*>(b)->middleline(line);
+}
+
+void fl_browser_bottomline(BROWSER b, int line) {
+ reinterpret_cast<Fl_Browser*>(b)->bottomline(line);
+}
+
+void fl_browser_lineposition(BROWSER b, int line, int p) {
+ reinterpret_cast<Fl_Browser*>(b)->lineposition
+ (line, static_cast<Fl_Browser::Fl_Line_Position>(p));
+}
+
+
+
+
+int fl_browser_select(BROWSER b, int l, int v) {
+ return reinterpret_cast<Fl_Browser*>(b)->select(l, v);
+}
+
+int fl_browser_selected(BROWSER b, int l) {
+ return reinterpret_cast<Fl_Browser*>(b)->selected(l);
+}
+
+int fl_browser_value(BROWSER b) {
+ return reinterpret_cast<Fl_Browser*>(b)->value();
+}
+
+
+
+
+int fl_browser_visible(BROWSER b, int l) {
+ return reinterpret_cast<Fl_Browser*>(b)->visible(l);
+}
+
+void fl_browser_make_visible(BROWSER b, int l) {
+ reinterpret_cast<Fl_Browser*>(b)->make_visible(l);
+}
+
+int fl_browser_displayed(BROWSER b, int l) {
+ return reinterpret_cast<Fl_Browser*>(b)->displayed(l);
+}
+
+void fl_browser_show_line(BROWSER b, int l) {
+ reinterpret_cast<Fl_Browser*>(b)->show(l);
+}
+
+void fl_browser_hide_line(BROWSER b, int l) {
+ reinterpret_cast<Fl_Browser*>(b)->hide(l);
+}
+
+void fl_browser_show(BROWSER b) {
+ reinterpret_cast<Fl_Browser*>(b)->show();
+}
+
+void fl_browser_hide(BROWSER b) {
+ reinterpret_cast<Fl_Browser*>(b)->hide();
+}
+
+
+
+
+void fl_browser_set_icon(BROWSER b, int l, void * c) {
+ reinterpret_cast<Fl_Browser*>(b)->icon(l, reinterpret_cast<Fl_Image*>(c));
+}
+
+void fl_browser_remove_icon(BROWSER b, int l) {
+ reinterpret_cast<Fl_Browser*>(b)->remove_icon(l);
+}
+
+
+
+
+int fl_browser_full_height(BROWSER c) {
+ return reinterpret_cast<My_Browser*>(c)->Fl_Browser::full_height();
+}
+
+int fl_browser_incr_height(BROWSER c) {
+ return reinterpret_cast<My_Browser*>(c)->Fl_Browser::incr_height();
+}
+
+
+
+
+int fl_browser_item_width(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->item_width(item);
+}
+
+int fl_browser_item_height(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->item_height(item);
+}
+
+void * fl_browser_item_first(BROWSER b) {
+ return reinterpret_cast<My_Browser*>(b)->item_first();
+}
+
+void * fl_browser_item_last(BROWSER b) {
+ return reinterpret_cast<My_Browser*>(b)->item_last();
+}
+
+void * fl_browser_item_next(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->item_next(item);
+}
+
+void * fl_browser_item_prev(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->item_prev(item);
+}
+
+void * fl_browser_item_at(BROWSER b, int index) {
+ return reinterpret_cast<My_Browser*>(b)->item_at(index);
+}
+
+void fl_browser_item_select(BROWSER b, void * item, int val) {
+ reinterpret_cast<My_Browser*>(b)->item_select(item, val);
+}
+
+int fl_browser_item_selected(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->item_selected(item);
+}
+
+void fl_browser_item_swap(BROWSER b, void * x, void * y) {
+ reinterpret_cast<My_Browser*>(b)->item_swap(x, y);
+}
+
+const char * fl_browser_item_text(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->item_text(item);
+}
+
+void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h) {
+ reinterpret_cast<My_Browser*>(b)->item_draw(item, x, y, w, h);
+}
+
+
+
+
+int fl_browser_lineno(BROWSER b, void * item) {
+ return reinterpret_cast<My_Browser*>(b)->lineno(item);
+}
+
+
+
+
+// These have to be reimplemented due to relying on custom class extensions
+
+void * fl_browser_selection(BROWSER c) {
+ return reinterpret_cast<My_Browser*>(c)->selection();
+}
+
+int fl_browser_displayed2(BROWSER c, void * i) {
+ return reinterpret_cast<My_Browser*>(c)->Fl_Browser_::displayed(i);
+}
+
+void * fl_browser_find_item(BROWSER c, int y) {
+ return reinterpret_cast<My_Browser*>(c)->find_item(y);
+}
+
+void * fl_browser_top(BROWSER c) {
+ return reinterpret_cast<My_Browser*>(c)->top();
+}
+
+
+
+
+void fl_browser_bbox(BROWSER c, int &x, int &y, int &w, int &h) {
+ reinterpret_cast<My_Browser*>(c)->bbox(x, y, w, h);
+}
+
+int fl_browser_leftedge(BROWSER c) {
+ return reinterpret_cast<My_Browser*>(c)->leftedge();
+}
+
+void fl_browser_redraw_line(BROWSER c, void * i) {
+ reinterpret_cast<My_Browser*>(c)->redraw_line(i);
+}
+
+void fl_browser_redraw_lines(BROWSER c) {
+ reinterpret_cast<My_Browser*>(c)->redraw_lines();
+}
+
+
+
+
+int fl_browser_full_width(BROWSER c) {
+ return reinterpret_cast<My_Browser*>(c)->Fl_Browser::full_width();
+}
+
+int fl_browser_item_quick_height(BROWSER c, void * i) {
+ return reinterpret_cast<My_Browser*>(c)->Fl_Browser::item_quick_height(i);
+}
+
+
+
+
+void fl_browser_new_list(BROWSER b) {
+ reinterpret_cast<My_Browser*>(b)->new_list();
+}
+
+void fl_browser_inserting(BROWSER b, void * a1, void * a2) {
+ reinterpret_cast<My_Browser*>(b)->inserting(a1, a2);
+}
+
+void fl_browser_deleting(BROWSER b, void * item) {
+ reinterpret_cast<My_Browser*>(b)->deleting(item);
+}
+
+void fl_browser_replacing(BROWSER b, void * a1, void * a2) {
+ reinterpret_cast<My_Browser*>(b)->replacing(a1, a2);
+}
+
+void fl_browser_swapping(BROWSER b, void * a1, void * a2) {
+ reinterpret_cast<My_Browser*>(b)->swapping(a1, a2);
+}
+
+
+
+
+void fl_browser_draw(BROWSER b) {
+ reinterpret_cast<My_Browser*>(b)->Fl_Browser::draw();
+}
+
+int fl_browser_handle(BROWSER b, int e) {
+ return reinterpret_cast<My_Browser*>(b)->Fl_Browser::handle(e);
+}
+
+
diff --git a/src/c_fl_browser.h b/src/c_fl_browser.h
new file mode 100644
index 0000000..98beec6
--- /dev/null
+++ b/src/c_fl_browser.h
@@ -0,0 +1,118 @@
+
+
+// Programmed by Jedidiah Barber
+// Released into the public domain
+
+
+#ifndef FL_BROWSER_GUARD
+#define FL_BROWSER_GUARD
+
+
+typedef void* BROWSER;
+
+
+extern "C" BROWSER new_fl_browser(int x, int y, int w, int h, char * label);
+extern "C" void free_fl_browser(BROWSER b);
+
+
+extern "C" void fl_browser_add(BROWSER b, const char * text, void * d=0);
+extern "C" void fl_browser_insert(BROWSER b, int line, const char * text, void * d=0);
+extern "C" void fl_browser_move(BROWSER b, int to, int from);
+extern "C" void fl_browser_swap(BROWSER b, int x, int y);
+extern "C" void fl_browser_remove(BROWSER b, int line);
+extern "C" void fl_browser_clear(BROWSER b);
+extern "C" int fl_browser_size(BROWSER b);
+
+
+extern "C" int fl_browser_load(BROWSER b, const char * f);
+extern "C" const char * fl_browser_get_text(BROWSER b, int line);
+extern "C" void fl_browser_set_text(BROWSER b, int line, const char * text);
+extern "C" int fl_browser_get_textsize(BROWSER b);
+extern "C" void fl_browser_set_textsize(BROWSER b, int size);
+
+
+extern "C" char fl_browser_get_column_char(BROWSER b);
+extern "C" void fl_browser_set_column_char(BROWSER b, char c);
+extern "C" void fl_browser_set_column_widths(BROWSER b, void * w);
+extern "C" char fl_browser_get_format_char(BROWSER b);
+extern "C" void fl_browser_set_format_char(BROWSER b, char c);
+
+
+extern "C" int fl_browser_get_topline(BROWSER b);
+extern "C" void fl_browser_set_topline(BROWSER b, int line);
+extern "C" void fl_browser_middleline(BROWSER b, int line);
+extern "C" void fl_browser_bottomline(BROWSER b, int line);
+extern "C" void fl_browser_lineposition(BROWSER b, int line, int p);
+
+
+extern "C" int fl_browser_select(BROWSER b, int l, int v);
+extern "C" int fl_browser_selected(BROWSER b, int l);
+extern "C" int fl_browser_value(BROWSER b);
+
+
+extern "C" int fl_browser_visible(BROWSER b, int l);
+extern "C" void fl_browser_make_visible(BROWSER b, int l);
+extern "C" int fl_browser_displayed(BROWSER b, int l);
+extern "C" void fl_browser_show_line(BROWSER b, int l);
+extern "C" void fl_browser_hide_line(BROWSER b, int l);
+extern "C" void fl_browser_show(BROWSER b);
+extern "C" void fl_browser_hide(BROWSER b);
+
+
+extern "C" void fl_browser_set_icon(BROWSER b, int l, void * c);
+extern "C" void fl_browser_remove_icon(BROWSER b, int l);
+
+
+extern "C" int fl_browser_full_height(BROWSER c);
+extern "C" int fl_browser_incr_height(BROWSER c);
+
+
+extern "C" int fl_browser_item_width(BROWSER b, void * item);
+extern "C" int fl_browser_item_height(BROWSER b, void * item);
+extern "C" void * fl_browser_item_first(BROWSER b);
+extern "C" void * fl_browser_item_last(BROWSER b);
+extern "C" void * fl_browser_item_next(BROWSER b, void * item);
+extern "C" void * fl_browser_item_prev(BROWSER b, void * item);
+extern "C" void * fl_browser_item_at(BROWSER b, int index);
+extern "C" void fl_browser_item_select(BROWSER b, void * item, int val=1);
+extern "C" int fl_browser_item_selected(BROWSER b, void * item);
+extern "C" void fl_browser_item_swap(BROWSER b, void * x, void * y);
+extern "C" const char * fl_browser_item_text(BROWSER b, void * item);
+extern "C" void fl_browser_item_draw(BROWSER b, void * item, int x, int y, int w, int h);
+
+
+extern "C" int fl_browser_lineno(BROWSER b, void * item);
+
+
+// reimp below here
+
+extern "C" void * fl_browser_selection(BROWSER c);
+extern "C" int fl_browser_displayed2(BROWSER c, void * i);
+extern "C" void * fl_browser_find_item(BROWSER c, int y);
+extern "C" void * fl_browser_top(BROWSER c);
+
+
+extern "C" void fl_browser_bbox(BROWSER c, int &x, int &y, int &w, int &h);
+extern "C" int fl_browser_leftedge(BROWSER c);
+extern "C" void fl_browser_redraw_line(BROWSER c, void * i);
+extern "C" void fl_browser_redraw_lines(BROWSER c);
+
+
+extern "C" int fl_browser_full_width(BROWSER c);
+extern "C" int fl_browser_item_quick_height(BROWSER c, void * i);
+
+
+extern "C" void fl_browser_new_list(BROWSER b);
+extern "C" void fl_browser_inserting(BROWSER b, void * a1, void * a2);
+extern "C" void fl_browser_deleting(BROWSER b, void * item);
+extern "C" void fl_browser_replacing(BROWSER b, void * a1, void * a2);
+extern "C" void fl_browser_swapping(BROWSER b, void * a1, void * a2);
+
+
+extern "C" void fl_browser_draw(BROWSER b);
+extern "C" int fl_browser_handle(BROWSER b, int e);
+
+
+#endif
+
+
diff --git a/src/c_fl_error.cpp b/src/c_fl_error.cpp
index 2b83187..e38481a 100644
--- a/src/c_fl_error.cpp
+++ b/src/c_fl_error.cpp
@@ -5,12 +5,23 @@
#include <FL/Fl.H>
+#include <errno.h>
#include <stdarg.h>
+#include <string.h>
#include "c_fl_error.h"
+// Obtaining general error messages from errno
+
+char * get_error_message() {
+ return strerror(errno);
+}
+
+
+
+
// Exports from Ada
extern "C" void error_warning_hook(const char * m);
diff --git a/src/c_fl_error.h b/src/c_fl_error.h
index b8ffb00..1d4bc76 100644
--- a/src/c_fl_error.h
+++ b/src/c_fl_error.h
@@ -8,6 +8,9 @@
#define FL_ERROR_GUARD
+extern "C" char * get_error_message();
+
+
extern "C" const int error_bsize;
diff --git a/src/fltk-widgets-groups-browsers-textline.adb b/src/fltk-widgets-groups-browsers-textline.adb
new file mode 100644
index 0000000..de3f339
--- /dev/null
+++ b/src/fltk-widgets-groups-browsers-textline.adb
@@ -0,0 +1,1255 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ Ada.Unchecked_Deallocation,
+ FLTK.Images,
+ Interfaces.C.Strings;
+
+use type
+
+ Interfaces.C.int,
+ Interfaces.C.Strings.chars_ptr;
+
+
+package body FLTK.Widgets.Groups.Browsers.Textline is
+
+
+ ------------------------
+ -- Functions From C --
+ ------------------------
+
+ function get_error_message
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, get_error_message, "get_error_message");
+ pragma Inline (get_error_message);
+
+
+
+
+ function new_fl_browser
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return Storage.Integer_Address;
+ pragma Import (C, new_fl_browser, "new_fl_browser");
+ pragma Inline (new_fl_browser);
+
+ procedure free_fl_browser
+ (B : in Storage.Integer_Address);
+ pragma Import (C, free_fl_browser, "free_fl_browser");
+ pragma Inline (free_fl_browser);
+
+
+
+
+ procedure fl_browser_add
+ (B : in Storage.Integer_Address;
+ T : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_add, "fl_browser_add");
+ pragma Inline (fl_browser_add);
+
+ procedure fl_browser_insert
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ T : in Interfaces.C.char_array;
+ D : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_insert, "fl_browser_insert");
+ pragma Inline (fl_browser_insert);
+
+ procedure fl_browser_move
+ (B : in Storage.Integer_Address;
+ T, F : in Interfaces.C.int);
+ pragma Import (C, fl_browser_move, "fl_browser_move");
+ pragma Inline (fl_browser_move);
+
+ procedure fl_browser_swap
+ (B : in Storage.Integer_Address;
+ X, Y : in Interfaces.C.int);
+ pragma Import (C, fl_browser_swap, "fl_browser_swap");
+ pragma Inline (fl_browser_swap);
+
+ procedure fl_browser_remove
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_remove, "fl_browser_remove");
+ pragma Inline (fl_browser_remove);
+
+ procedure fl_browser_clear
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_clear, "fl_browser_clear");
+ pragma Inline (fl_browser_clear);
+
+ function fl_browser_size
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_size, "fl_browser_size");
+ pragma Inline (fl_browser_size);
+
+
+
+
+ function fl_browser_load
+ (B : in Storage.Integer_Address;
+ F : in Interfaces.C.char_array)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_load, "fl_browser_load");
+ pragma Inline (fl_browser_load);
+
+ function fl_browser_get_text
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_browser_get_text, "fl_browser_get_text");
+ pragma Inline (fl_browser_get_text);
+
+ procedure fl_browser_set_text
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_browser_set_text, "fl_browser_set_text");
+ pragma Inline (fl_browser_set_text);
+
+ function fl_browser_get_textsize
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_get_textsize, "fl_browser_get_textsize");
+ pragma Inline (fl_browser_get_textsize);
+
+ procedure fl_browser_set_textsize
+ (B : in Storage.Integer_Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_browser_set_textsize, "fl_browser_set_textsize");
+ pragma Inline (fl_browser_set_textsize);
+
+
+
+
+ function fl_browser_get_column_char
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.char;
+ pragma Import (C, fl_browser_get_column_char, "fl_browser_get_column_char");
+ pragma Inline (fl_browser_get_column_char);
+
+ procedure fl_browser_set_column_char
+ (B : in Storage.Integer_Address;
+ C : in Interfaces.C.char);
+ pragma Import (C, fl_browser_set_column_char, "fl_browser_set_column_char");
+ pragma Inline (fl_browser_set_column_char);
+
+ procedure fl_browser_set_column_widths
+ (B, W : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_set_column_widths, "fl_browser_set_column_widths");
+ pragma Inline (fl_browser_set_column_widths);
+
+ function fl_browser_get_format_char
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.char;
+ pragma Import (C, fl_browser_get_format_char, "fl_browser_get_format_char");
+ pragma Inline (fl_browser_get_format_char);
+
+ procedure fl_browser_set_format_char
+ (B : in Storage.Integer_Address;
+ C : in Interfaces.C.char);
+ pragma Import (C, fl_browser_set_format_char, "fl_browser_set_format_char");
+ pragma Inline (fl_browser_set_format_char);
+
+
+
+
+ function fl_browser_get_topline
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_get_topline, "fl_browser_get_topline");
+ pragma Inline (fl_browser_get_topline);
+
+ procedure fl_browser_set_topline
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_set_topline, "fl_browser_set_topline");
+ pragma Inline (fl_browser_set_topline);
+
+ procedure fl_browser_middleline
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_middleline, "fl_browser_middleline");
+ pragma Inline (fl_browser_middleline);
+
+ procedure fl_browser_bottomline
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_bottomline, "fl_browser_bottomline");
+ pragma Inline (fl_browser_bottomline);
+
+ procedure fl_browser_lineposition
+ (B : in Storage.Integer_Address;
+ L, P : in Interfaces.C.int);
+ pragma Import (C, fl_browser_lineposition, "fl_browser_lineposition");
+ pragma Inline (fl_browser_lineposition);
+
+
+
+
+ function fl_browser_select
+ (B : in Storage.Integer_Address;
+ L, V : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_select, "fl_browser_select");
+ pragma Inline (fl_browser_select);
+
+ function fl_browser_selected
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_selected, "fl_browser_selected");
+ pragma Inline (fl_browser_selected);
+
+ function fl_browser_value
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_value, "fl_browser_value");
+ pragma Inline (fl_browser_value);
+
+
+
+
+ function fl_browser_visible
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_visible, "fl_browser_visible");
+ pragma Inline (fl_browser_visible);
+
+ procedure fl_browser_make_visible
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_make_visible, "fl_browser_make_visible");
+ pragma Inline (fl_browser_make_visible);
+
+ function fl_browser_displayed
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_displayed, "fl_browser_displayed");
+ pragma Inline (fl_browser_displayed);
+
+ procedure fl_browser_show_line
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_show_line, "fl_browser_show_line");
+ pragma Inline (fl_browser_show_line);
+
+ procedure fl_browser_hide_line
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_hide_line, "fl_browser_hide_line");
+ pragma Inline (fl_browser_hide_line);
+
+ procedure fl_browser_show
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_show, "fl_browser_show");
+ pragma Inline (fl_browser_show);
+
+ procedure fl_browser_hide
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_hide, "fl_browser_hide");
+ pragma Inline (fl_browser_hide);
+
+
+
+
+ procedure fl_browser_set_icon
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int;
+ C : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_set_icon, "fl_browser_set_icon");
+ pragma Inline (fl_browser_set_icon);
+
+ procedure fl_browser_remove_icon
+ (B : in Storage.Integer_Address;
+ L : in Interfaces.C.int);
+ pragma Import (C, fl_browser_remove_icon, "fl_browser_remove_icon");
+ pragma Inline (fl_browser_remove_icon);
+
+
+
+
+ function fl_browser_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_width, "fl_browser_item_width");
+ pragma Inline (fl_browser_item_width);
+
+ function fl_browser_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_height, "fl_browser_item_height");
+ pragma Inline (fl_browser_item_height);
+
+ function fl_browser_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_first, "fl_browser_item_first");
+ pragma Inline (fl_browser_item_first);
+
+ function fl_browser_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_last, "fl_browser_item_last");
+ pragma Inline (fl_browser_item_last);
+
+ function fl_browser_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_next, "fl_browser_item_next");
+ pragma Inline (fl_browser_item_next);
+
+ function fl_browser_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_prev, "fl_browser_item_prev");
+ pragma Inline (fl_browser_item_prev);
+
+ function fl_browser_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_item_at, "fl_browser_item_at");
+ pragma Inline (fl_browser_item_at);
+
+ procedure fl_browser_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ pragma Import (C, fl_browser_item_select, "fl_browser_item_select");
+ pragma Inline (fl_browser_item_select);
+
+ function fl_browser_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_selected, "fl_browser_item_selected");
+ pragma Inline (fl_browser_item_selected);
+
+ procedure fl_browser_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_item_swap, "fl_browser_item_swap");
+ pragma Inline (fl_browser_item_swap);
+
+ function fl_browser_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_browser_item_text, "fl_browser_item_text");
+ pragma Inline (fl_browser_item_text);
+
+ procedure fl_browser_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ pragma Import (C, fl_browser_item_draw, "fl_browser_item_draw");
+ pragma Inline (fl_browser_item_draw);
+
+
+
+
+ function fl_browser_selection
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_selection, "fl_browser_selection");
+ pragma Inline (fl_browser_selection);
+
+ function fl_browser_displayed2
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_displayed2, "fl_browser_displayed2");
+ pragma Inline (fl_browser_displayed2);
+
+ function fl_browser_find_item
+ (B : in Storage.Integer_Address;
+ Y : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_find_item, "fl_browser_find_item");
+ pragma Inline (fl_browser_find_item);
+
+ function fl_browser_top
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ pragma Import (C, fl_browser_top, "fl_browser_top");
+ pragma Inline (fl_browser_top);
+
+
+
+
+ procedure fl_browser_bbox
+ (B : in Storage.Integer_Address;
+ X, Y, W, H : out Interfaces.C.int);
+ pragma Import (C, fl_browser_bbox, "fl_browser_bbox");
+ pragma Inline (fl_browser_bbox);
+
+ function fl_browser_leftedge
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_leftedge, "fl_browser_leftedge");
+ pragma Inline (fl_browser_leftedge);
+
+ procedure fl_browser_redraw_line
+ (B, I : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_redraw_line, "fl_browser_redraw_line");
+ pragma Inline (fl_browser_redraw_line);
+
+ procedure fl_browser_redraw_lines
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_redraw_lines, "fl_browser_redraw_lines");
+ pragma Inline (fl_browser_redraw_lines);
+
+
+
+
+ function fl_browser_full_width
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_full_width, "fl_browser_full_width");
+ pragma Inline (fl_browser_full_width);
+
+ function fl_browser_full_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_full_height, "fl_browser_full_height");
+ pragma Inline (fl_browser_full_height);
+
+ function fl_browser_incr_height
+ (B : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_incr_height, "fl_browser_incr_height");
+ pragma Inline (fl_browser_incr_height);
+
+ function fl_browser_item_quick_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_item_quick_height, "fl_browser_item_quick_height");
+ pragma Inline (fl_browser_item_quick_height);
+
+
+
+
+ function fl_browser_lineno
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_lineno, "fl_browser_lineno");
+ pragma Inline (fl_browser_lineno);
+
+
+
+
+ procedure fl_browser_new_list
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_new_list, "fl_browser_new_list");
+ pragma Inline (fl_browser_new_list);
+
+ procedure fl_browser_inserting
+ (B, A1, A2 : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_inserting, "fl_browser_inserting");
+ pragma Inline (fl_browser_inserting);
+
+ procedure fl_browser_deleting
+ (B, I : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_deleting, "fl_browser_deleting");
+ pragma Inline (fl_browser_deleting);
+
+ procedure fl_browser_replacing
+ (B, A1, A2 : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_replacing, "fl_browser_replacing");
+ pragma Inline (fl_browser_replacing);
+
+ procedure fl_browser_swapping
+ (B, A1, A2 : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_swapping, "fl_browser_swapping");
+ pragma Inline (fl_browser_swapping);
+
+
+
+
+ procedure fl_browser_draw
+ (B : in Storage.Integer_Address);
+ pragma Import (C, fl_browser_draw, "fl_browser_draw");
+ pragma Inline (fl_browser_draw);
+
+ function fl_browser_handle
+ (B : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ pragma Import (C, fl_browser_handle, "fl_browser_handle");
+ pragma Inline (fl_browser_handle);
+
+
+
+
+ -------------------
+ -- Destructors --
+ -------------------
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Object => C_Col_Widths,
+ Name => C_Col_Widths_Access);
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Object => FLTK.Images.Image'Class,
+ Name => Image_Access);
+
+
+ procedure Extra_Final
+ (This : in out Textline_Browser) is
+ begin
+ Free (This.Columns);
+ for Icon_Ptr of This.Icons loop
+ Free (Icon_Ptr);
+ end loop;
+ Extra_Final (Browser (This));
+ end Extra_Final;
+
+
+ procedure Finalize
+ (This : in out Textline_Browser) is
+ begin
+ Extra_Final (This);
+ if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
+ free_fl_browser (This.Void_Ptr);
+ This.Void_Ptr := Null_Pointer;
+ end if;
+ end Finalize;
+
+
+
+
+ --------------------
+ -- Constructors --
+ --------------------
+
+ procedure Extra_Init
+ (This : in out Textline_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String) is
+ begin
+ Extra_Init (Browser (This), X, Y, W, H, Text);
+ end Extra_Init;
+
+
+ procedure Initialize
+ (This : in out Textline_Browser) is
+ begin
+ This.Item_Override_Ptrs :=
+ (Item_Width_Ptr => fl_browser_item_width'Address,
+ Item_Height_Ptr => fl_browser_item_height'Address,
+ Item_First_Ptr => fl_browser_item_first'Address,
+ Item_Last_Ptr => fl_browser_item_last'Address,
+ Item_Next_Ptr => fl_browser_item_next'Address,
+ Item_Previous_Ptr => fl_browser_item_prev'Address,
+ Item_At_Ptr => fl_browser_item_at'Address,
+ Item_Select_Ptr => fl_browser_item_select'Address,
+ Item_Selected_Ptr => fl_browser_item_selected'Address,
+ Item_Swap_Ptr => fl_browser_item_swap'Address,
+ Item_Text_Ptr => fl_browser_item_text'Address,
+ Item_Draw_Ptr => fl_browser_item_draw'Address);
+ This.Item_Inherit_Ptrs :=
+ (Current_Selection_Ptr => fl_browser_selection'Address,
+ Is_Displayed_Ptr => fl_browser_displayed2'Address,
+ Find_Item_Ptr => fl_browser_find_item'Address,
+ Top_Item_Ptr => fl_browser_top'Address);
+ This.Redrawing_Ptrs :=
+ (Bounding_Box_Ptr => fl_browser_bbox'Address,
+ Left_Edge_Ptr => fl_browser_leftedge'Address,
+ Redraw_Line_Ptr => fl_browser_redraw_line'Address,
+ Redraw_List_Ptr => fl_browser_redraw_lines'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_browser_item_quick_height'Address);
+ This.Cache_Ptrs :=
+ (New_List_Ptr => fl_browser_new_list'Address,
+ Inserting_Ptr => fl_browser_inserting'Address,
+ Deleting_Ptr => fl_browser_deleting'Address,
+ Replacing_Ptr => fl_browser_replacing'Address,
+ Swapping_Ptr => fl_browser_swapping'Address);
+ This.Draw_Ptr := fl_browser_draw'Address;
+ This.Handle_Ptr := fl_browser_handle'Address;
+ This.Line_Number_Ptr := fl_browser_lineno'Address;
+ end Initialize;
+
+
+ package body Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Textline_Browser is
+ begin
+ return This : Textline_Browser do
+ This.Void_Ptr := new_fl_browser
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ Extra_Init (This, X, Y, W, H, Text);
+ end return;
+ end Create;
+
+ end Forge;
+
+
+
+
+ -----------------------
+ -- API Subprograms --
+ -----------------------
+
+ procedure Add
+ (This : in out Textline_Browser;
+ Text : in String) is
+ begin
+ fl_browser_add
+ (This.Void_Ptr,
+ Interfaces.C.To_C (Text),
+ Null_Pointer);
+ end Add;
+
+
+ procedure Insert
+ (This : in out Textline_Browser;
+ Above : in Positive;
+ Text : in String) is
+ begin
+ fl_browser_insert
+ (This.Void_Ptr,
+ Interfaces.C.int (Above),
+ Interfaces.C.To_C (Text),
+ Null_Pointer);
+ end Insert;
+
+
+ procedure Move
+ (This : in out Textline_Browser;
+ From, To : in Positive) is
+ begin
+ fl_browser_move
+ (This.Void_Ptr,
+ Interfaces.C.int (To),
+ Interfaces.C.int (From));
+ end Move;
+
+
+ procedure Swap
+ (This : in out Textline_Browser;
+ A, B : in Positive) is
+ begin
+ fl_browser_swap
+ (This.Void_Ptr,
+ Interfaces.C.int (A),
+ Interfaces.C.int (B));
+ end Swap;
+
+
+ procedure Remove
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_remove
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ end Remove;
+
+
+ procedure Clear
+ (This : in out Textline_Browser) is
+ begin
+ fl_browser_clear (This.Void_Ptr);
+ end Clear;
+
+
+ function Number_Of_Lines
+ (This : in Textline_Browser)
+ return Natural is
+ begin
+ return Natural (fl_browser_size (This.Void_Ptr));
+ end Number_Of_Lines;
+
+
+
+
+ procedure Load
+ (This : in out Textline_Browser;
+ File : in String)
+ is
+ Code : Interfaces.C.int := fl_browser_load (This.Void_Ptr, Interfaces.C.To_C (File));
+ begin
+ if Code = 0 then
+ raise Browser_Load_Error with Interfaces.C.Strings.Value (get_error_message);
+ elsif Code /= 1 then
+ raise Internal_FLTK_Error;
+ end if;
+ end Load;
+
+
+ function Get_Line_Text
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return String
+ is
+ Ptr : Interfaces.C.Strings.chars_ptr := fl_browser_get_text
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ begin
+ if Ptr = Interfaces.C.Strings.Null_Ptr then
+ return "";
+ else
+ return Interfaces.C.Strings.Value (Ptr);
+ end if;
+ end Get_Line_Text;
+
+
+ procedure Set_Line_Text
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Text : in String) is
+ begin
+ fl_browser_set_text
+ (This.Void_Ptr,
+ Interfaces.C.int (Line),
+ Interfaces.C.To_C (Text));
+ end Set_Line_Text;
+
+
+ function Get_Text_Size
+ (This : in Textline_Browser)
+ return Font_Size is
+ begin
+ return Font_Size (fl_browser_get_textsize (This.Void_Ptr));
+ end Get_Text_Size;
+
+
+ procedure Set_Text_Size
+ (This : in out Textline_Browser;
+ Size : in Font_Size) is
+ begin
+ fl_browser_set_textsize (This.Void_Ptr, Interfaces.C.int (Size));
+ end Set_Text_Size;
+
+
+
+
+ function Get_Column_Character
+ (This : in Textline_Browser)
+ return Character is
+ begin
+ return Interfaces.C.To_Ada (fl_browser_get_column_char (This.Void_Ptr));
+ end Get_Column_Character;
+
+
+ procedure Set_Column_Character
+ (This : in out Textline_Browser;
+ Value : in Character) is
+ begin
+ fl_browser_set_column_char (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Column_Character;
+
+
+ function Get_Column_Widths
+ (This : in Textline_Browser)
+ return Column_Widths is
+ begin
+ if This.Columns = null then
+ return Result : Column_Widths (1 .. 0);
+ else
+ return Result : Column_Widths (This.Columns'First .. This.Columns'Last - 1) do
+ for Index in Result'Range loop
+ Result (Index) := Integer (This.Columns (Index));
+ end loop;
+ end return;
+ end if;
+ end Get_Column_Widths;
+
+
+ procedure Set_Column_Widths
+ (This : in out Textline_Browser;
+ Widths : in Column_Widths) is
+ begin
+ Free (This.Columns);
+ This.Columns := new C_Col_Widths (1 .. Widths'Length + 1);
+ for Index in This.Columns'Range loop
+ This.Columns (Index) := Interfaces.C.int (Widths (Widths'First + Index - 1));
+ end loop;
+ This.Columns (This.Columns'Last) := 0;
+ fl_browser_set_column_widths (This.Void_Ptr, Storage.To_Integer (This.Columns.all'Address));
+ end Set_Column_Widths;
+
+
+ function Get_Format_Character
+ (This : in Textline_Browser)
+ return Character is
+ begin
+ return Interfaces.C.To_Ada (fl_browser_get_format_char (This.Void_Ptr));
+ end Get_Format_Character;
+
+
+ procedure Set_Format_Character
+ (This : in out Textline_Browser;
+ Value : in Character) is
+ begin
+ fl_browser_set_format_char (This.Void_Ptr, Interfaces.C.To_C (Value));
+ end Set_Format_Character;
+
+
+
+
+ function Get_Top_Line
+ (This : in Textline_Browser)
+ return Positive is
+ begin
+ return Positive (fl_browser_get_topline (This.Void_Ptr));
+ end Get_Top_Line;
+
+
+ procedure Set_Top_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_set_topline (This.Void_Ptr, Interfaces.C.int (Line));
+ end Set_Top_Line;
+
+
+ procedure Set_Middle_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_middleline (This.Void_Ptr, Interfaces.C.int (Line));
+ end Set_Middle_Line;
+
+
+ procedure Set_Bottom_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_bottomline (This.Void_Ptr, Interfaces.C.int (Line));
+ end Set_Bottom_Line;
+
+
+ procedure Set_Line_Position
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Place : in Line_Position) is
+ begin
+ fl_browser_lineposition (This.Void_Ptr, Interfaces.C.int (Line), Line_Position'Pos (Place));
+ end Set_Line_Position;
+
+
+
+
+ function Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_browser_select
+ (This.Void_Ptr,
+ Interfaces.C.int (Line),
+ Boolean'Pos (State));
+ begin
+ if Code not in 0 .. 1 then
+ raise Internal_FLTK_Error;
+ else
+ return Boolean'Val (Code);
+ end if;
+ end Set_Select;
+
+
+ procedure Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True)
+ is
+ Code : Interfaces.C.int := fl_browser_select
+ (This.Void_Ptr,
+ Interfaces.C.int (Line),
+ Boolean'Pos (State));
+ begin
+ if Code not in 0 .. 1 then
+ raise Internal_FLTK_Error;
+ end if;
+ end Set_Select;
+
+
+ function Is_Selected
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_browser_selected
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ begin
+ if Code not in 0 .. 1 then
+ raise Internal_FLTK_Error;
+ else
+ return Boolean'Val (Code);
+ end if;
+ end Is_Selected;
+
+
+ function Selected_Index
+ (This : in Textline_Browser)
+ return Natural is
+ begin
+ return Natural (fl_browser_value (This.Void_Ptr));
+ end Selected_Index;
+
+
+
+
+ function Is_Visible
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean is
+ begin
+ return fl_browser_visible (This.Void_Ptr, Interfaces.C.int (Line)) /= 0;
+ end Is_Visible;
+
+
+ procedure Make_Visible
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_make_visible (This.Void_Ptr, Interfaces.C.int (Line));
+ end Make_Visible;
+
+
+ function Is_Displayed
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean
+ is
+ Code : Interfaces.C.int := fl_browser_displayed
+ (This.Void_Ptr,
+ Interfaces.C.int (Line));
+ begin
+ if Code not in 0 .. 1 then
+ raise Internal_FLTK_Error;
+ else
+ return Boolean'Val (Code);
+ end if;
+ end Is_Displayed;
+
+
+ procedure Show_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_show_line (This.Void_Ptr, Interfaces.C.int (Line));
+ end Show_Line;
+
+
+ procedure Hide_Line
+ (This : in out Textline_Browser;
+ Line : in Positive) is
+ begin
+ fl_browser_hide_line (This.Void_Ptr, Interfaces.C.int (Line));
+ end Hide_Line;
+
+
+ procedure Show
+ (This : in out Textline_Browser) is
+ begin
+ fl_browser_show (This.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (This : in out Textline_Browser) is
+ begin
+ fl_browser_hide (This.Void_Ptr);
+ end Hide;
+
+
+
+
+ function Has_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean is
+ begin
+ return Line <= This.Icons.Last_Index and then This.Icons.Element (Line) /= null;
+ end Has_Icon;
+
+
+ function Get_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return FLTK.Images.Image_Reference is
+ begin
+ return Ref : FLTK.Images.Image_Reference (Data => This.Icons.Element (Line));
+ end Get_Icon;
+
+
+ procedure Set_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Icon : in FLTK.Images.Image'Class) is
+ begin
+ fl_browser_set_icon (This.Void_Ptr, Interfaces.C.int (Line), Wrapper (Icon).Void_Ptr);
+ if Line > This.Icons.Last_Index then
+ This.Icons.Append (null, Ada.Containers.Count_Type (Line - This.Icons.Last_Index - 1));
+ This.Icons.Append (new FLTK.Images.Image);
+ Wrapper (This.Icons.Element (Line).all).Needs_Dealloc := False;
+ elsif This.Icons.Element (Line) = null then
+ This.Icons.Replace_Element (Line, new FLTK.Images.Image);
+ Wrapper (This.Icons.Element (Line).all).Needs_Dealloc := False;
+ end if;
+ Wrapper (This.Icons.Element (Line).all).Void_Ptr := Wrapper (Icon).Void_Ptr;
+ end Set_Icon;
+
+
+ procedure Remove_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive)
+ is
+ Ptr : Image_Access;
+ begin
+ fl_browser_remove_icon (This.Void_Ptr, Interfaces.C.int (Line));
+ if Line <= This.Icons.Last_Index then
+ Ptr := This.Icons.Element (Line);
+ Free (Ptr);
+ This.Icons.Replace_Element (Line, null);
+ end if;
+ end Remove_Icon;
+
+
+
+
+ function Full_List_Height
+ (This : in Textline_Browser)
+ return Integer is
+ begin
+ return Browser (This).Full_List_Height;
+ end Full_List_Height;
+
+
+ function Average_Item_Height
+ (This : in Textline_Browser)
+ return Integer is
+ begin
+ return Browser (This).Average_Item_Height;
+ end Average_Item_Height;
+
+
+
+
+ function Item_Width
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer
+ is
+ function my_item_width
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_width'Address use This.Item_Override_Ptrs (Item_Width_Ptr);
+ pragma Import (Ada, my_item_width);
+ begin
+ return Integer (my_item_width (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Width;
+
+
+ function Item_Height
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer
+ is
+ function my_item_height
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_height'Address use This.Item_Override_Ptrs (Item_Height_Ptr);
+ pragma Import (Ada, my_item_height);
+ begin
+ return Integer (my_item_height (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Height;
+
+
+ function Item_First
+ (This : in Textline_Browser)
+ return Item_Cursor
+ is
+ function my_item_first
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_first'Address use This.Item_Override_Ptrs (Item_First_Ptr);
+ pragma Import (Ada, my_item_first);
+ begin
+ return Address_To_Cursor (my_item_first (This.Void_Ptr));
+ end Item_First;
+
+
+ function Item_Last
+ (This : in Textline_Browser)
+ return Item_Cursor
+ is
+ function my_item_last
+ (B : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_last'Address use This.Item_Override_Ptrs (Item_Last_Ptr);
+ pragma Import (Ada, my_item_last);
+ begin
+ return Address_To_Cursor (my_item_last (This.Void_Ptr));
+ end Item_Last;
+
+
+ function Item_Next
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor
+ is
+ function my_item_next
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_next'Address use This.Item_Override_Ptrs (Item_Next_Ptr);
+ pragma Import (Ada, my_item_next);
+ begin
+ return Address_To_Cursor (my_item_next (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Next;
+
+
+ function Item_Previous
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor
+ is
+ function my_item_prev
+ (B, I : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_item_prev'Address use This.Item_Override_Ptrs (Item_Previous_Ptr);
+ pragma Import (Ada, my_item_prev);
+ begin
+ return Address_To_Cursor (my_item_prev (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Previous;
+
+
+ function Item_At
+ (This : in Textline_Browser;
+ Index : in Positive)
+ return Item_Cursor
+ is
+ function my_item_at
+ (B : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ for my_item_at'Address use This.Item_Override_Ptrs (Item_At_Ptr);
+ pragma Import (Ada, my_item_at);
+ begin
+ return Address_To_Cursor (my_item_at (This.Void_Ptr, Interfaces.C.int (Index)));
+ end Item_At;
+
+
+ procedure Item_Select
+ (This : in out Textline_Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True)
+ is
+ procedure my_item_select
+ (B, I : in Storage.Integer_Address;
+ V : in Interfaces.C.int);
+ for my_item_select'Address use This.Item_Override_Ptrs (Item_Select_Ptr);
+ pragma Import (Ada, my_item_select);
+ begin
+ my_item_select (This.Void_Ptr, Cursor_To_Address (Item), Boolean'Pos (State));
+ end Item_Select;
+
+
+ function Item_Selected
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Boolean
+ is
+ function my_item_selected
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_selected'Address use This.Item_Override_Ptrs (Item_Selected_Ptr);
+ pragma Import (Ada, my_item_selected);
+ Code : Interfaces.C.int := my_item_selected (This.Void_Ptr, Cursor_To_Address (Item));
+ begin
+ if Code not in 0 .. 1 then
+ raise Internal_FLTK_Error;
+ else
+ return Boolean'Val (Code);
+ end if;
+ end Item_Selected;
+
+
+ procedure Item_Swap
+ (This : in out Textline_Browser;
+ A, B : in Item_Cursor)
+ is
+ procedure my_item_swap
+ (B, X, Y : in Storage.Integer_Address);
+ for my_item_swap'Address use This.Item_Override_Ptrs (Item_Swap_Ptr);
+ pragma Import (Ada, my_item_swap);
+ begin
+ my_item_swap (This.Void_Ptr, Cursor_To_Address (A), Cursor_To_Address (B));
+ end Item_Swap;
+
+
+ function Item_Text
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return String
+ is
+ function my_item_text
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.Strings.chars_ptr;
+ for my_item_text'Address use This.Item_Override_Ptrs (Item_Text_Ptr);
+ pragma Import (Ada, my_item_text);
+ begin
+ return Interfaces.C.Strings.Value (my_item_text (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Item_Text;
+
+
+ procedure Item_Draw
+ (This : in Textline_Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer)
+ is
+ procedure my_item_draw
+ (B, I : in Storage.Integer_Address;
+ X, Y, W, H : in Interfaces.C.int);
+ for my_item_draw'Address use This.Item_Override_Ptrs (Item_Draw_Ptr);
+ pragma Import (Ada, my_item_draw);
+ begin
+ my_item_draw
+ (This.Void_Ptr,
+ Cursor_To_Address (Item),
+ Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H));
+ end Item_Draw;
+
+
+
+
+ function Line_Number
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Natural
+ is
+ function my_lineno
+ (B, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_lineno'Address use This.Line_Number_Ptr;
+ pragma Import (Ada, my_lineno);
+ begin
+ return Natural (my_lineno (This.Void_Ptr, Cursor_To_Address (Item)));
+ end Line_Number;
+
+
+end FLTK.Widgets.Groups.Browsers.Textline;
+
+
diff --git a/src/fltk-widgets-groups-browsers-textline.ads b/src/fltk-widgets-groups-browsers-textline.ads
new file mode 100644
index 0000000..e9749dc
--- /dev/null
+++ b/src/fltk-widgets-groups-browsers-textline.ads
@@ -0,0 +1,427 @@
+
+
+-- Programmed by Jedidiah Barber
+-- Released into the public domain
+
+
+with
+
+ FLTK.Images;
+
+private with
+
+ Ada.Containers.Vectors,
+ Interfaces.C,
+ System;
+
+
+package FLTK.Widgets.Groups.Browsers.Textline is
+
+
+ type Textline_Browser is new Browser with private;
+
+ type Textline_Browser_Reference (Data : not null access Textline_Browser'Class) is
+ limited null record with Implicit_Dereference => Data;
+
+ type Line_Position is (Top, Bottom, Middle);
+
+ type Column_Widths is array (Positive range <>) of Integer;
+
+
+ Browser_Load_Error : exception;
+
+
+
+
+ package Forge is
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String := "")
+ return Textline_Browser;
+
+ end Forge;
+
+
+
+
+ -- Directly manipulating lines
+
+ procedure Add
+ (This : in out Textline_Browser;
+ Text : in String);
+
+ procedure Insert
+ (This : in out Textline_Browser;
+ Above : in Positive;
+ Text : in String);
+
+ -- To destination calculated after From line is removed.
+ -- Also, note that To/From ordering is opposite from C++
+ procedure Move
+ (This : in out Textline_Browser;
+ From, To : in Positive);
+
+ procedure Swap
+ (This : in out Textline_Browser;
+ A, B : in Positive);
+
+ procedure Remove
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ procedure Clear
+ (This : in out Textline_Browser);
+
+ function Number_Of_Lines
+ (This : in Textline_Browser)
+ return Natural;
+
+
+
+
+ -- Loading text and text size
+
+ procedure Load
+ (This : in out Textline_Browser;
+ File : in String);
+
+ function Get_Line_Text
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return String;
+
+ procedure Set_Line_Text
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Text : in String);
+
+ function Get_Text_Size
+ (This : in Textline_Browser)
+ return Font_Size;
+
+ procedure Set_Text_Size
+ (This : in out Textline_Browser;
+ Size : in Font_Size);
+
+
+
+
+ -- Columns and formatting
+
+ function Get_Column_Character
+ (This : in Textline_Browser)
+ return Character;
+
+ procedure Set_Column_Character
+ (This : in out Textline_Browser;
+ Value : in Character);
+
+ function Get_Column_Widths
+ (This : in Textline_Browser)
+ return Column_Widths;
+
+ -- An internal copy is kept of Widths, unlike the C++ version
+ procedure Set_Column_Widths
+ (This : in out Textline_Browser;
+ Widths : in Column_Widths);
+
+ function Get_Format_Character
+ (This : in Textline_Browser)
+ return Character;
+
+ procedure Set_Format_Character
+ (This : in out Textline_Browser;
+ Value : in Character);
+
+
+
+
+ -- Line positioning
+
+ function Get_Top_Line
+ (This : in Textline_Browser)
+ return Positive;
+
+ procedure Set_Top_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ procedure Set_Middle_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ procedure Set_Bottom_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ procedure Set_Line_Position
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Place : in Line_Position);
+
+
+
+
+ -- Line selection
+
+ function Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True)
+ return Boolean;
+
+ procedure Set_Select
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ State : in Boolean := True);
+
+ function Is_Selected
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+
+ function Selected_Index
+ (This : in Textline_Browser)
+ return Natural;
+
+
+
+
+ -- Visibility, showing, hiding
+
+ function Is_Visible
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+
+ procedure Make_Visible
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ function Is_Displayed
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+
+ procedure Show_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ procedure Hide_Line
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+ procedure Show
+ (This : in out Textline_Browser);
+
+ procedure Hide
+ (This : in out Textline_Browser);
+
+
+
+
+ -- Icons for specific lines
+
+ function Has_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return Boolean;
+
+ function Get_Icon
+ (This : in Textline_Browser;
+ Line : in Positive)
+ return FLTK.Images.Image_Reference;
+
+ procedure Set_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive;
+ Icon : in FLTK.Images.Image'Class);
+
+ procedure Remove_Icon
+ (This : in out Textline_Browser;
+ Line : in Positive);
+
+
+
+
+ -- List dimensions
+
+ function Full_List_Height
+ (This : in Textline_Browser)
+ return Integer;
+
+ function Average_Item_Height
+ (This : in Textline_Browser)
+ return Integer;
+
+
+
+
+ -- Item implementation
+
+ function Item_Width
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer;
+
+ function Item_Height
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Integer;
+
+ function Item_First
+ (This : in Textline_Browser)
+ return Item_Cursor;
+
+ function Item_Last
+ (This : in Textline_Browser)
+ return Item_Cursor;
+
+ function Item_Next
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor;
+
+ function Item_Previous
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Item_Cursor;
+
+ function Item_At
+ (This : in Textline_Browser;
+ Index : in Positive)
+ return Item_Cursor;
+
+ procedure Item_Select
+ (This : in out Textline_Browser;
+ Item : in Item_Cursor;
+ State : in Boolean := True);
+
+ function Item_Selected
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Boolean;
+
+ procedure Item_Swap
+ (This : in out Textline_Browser;
+ A, B : in Item_Cursor);
+
+ function Item_Text
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return String;
+
+ procedure Item_Draw
+ (This : in Textline_Browser;
+ Item : in Item_Cursor;
+ X, Y, W, H : in Integer);
+
+
+
+
+ function Line_Number
+ (This : in Textline_Browser;
+ Item : in Item_Cursor)
+ return Natural;
+
+
+private
+
+
+ type C_Col_Widths is array (Positive range <>) of aliased Interfaces.C.int
+ with Convention => C;
+
+ type C_Col_Widths_Access is access C_Col_Widths;
+
+
+ type Image_Access is access FLTK.Images.Image'Class;
+
+ package Image_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Image_Access);
+
+
+ type Textline_Browser is new Browser with record
+ Columns : C_Col_Widths_Access;
+ Icons : Image_Vectors.Vector;
+ Item_Override_Ptrs : Item_Override_Fun_Ptr_Array;
+ Line_Number_Ptr : System.Address;
+ end record;
+
+ overriding procedure Initialize
+ (This : in out Textline_Browser);
+
+ overriding procedure Finalize
+ (This : in out Textline_Browser);
+
+ procedure Extra_Init
+ (This : in out Textline_Browser;
+ X, Y, W, H : in Integer;
+ Text : in String);
+
+ procedure Extra_Final
+ (This : in out Textline_Browser);
+
+
+ pragma Inline (Add);
+ pragma Inline (Insert);
+ pragma Inline (Move);
+ pragma Inline (Swap);
+ pragma Inline (Remove);
+ pragma Inline (Clear);
+ pragma Inline (Number_Of_Lines);
+
+ pragma Inline (Set_Line_Text);
+ pragma Inline (Get_Text_Size);
+ pragma Inline (Set_Text_Size);
+
+ pragma Inline (Get_Column_Character);
+ pragma Inline (Set_Column_Character);
+ pragma Inline (Get_Format_Character);
+ pragma Inline (Set_Format_Character);
+
+ pragma Inline (Get_Top_Line);
+ pragma Inline (Set_Top_Line);
+ pragma Inline (Set_Middle_Line);
+ pragma Inline (Set_Bottom_Line);
+ pragma Inline (Set_Line_Position);
+
+ pragma Inline (Selected_Index);
+
+ pragma Inline (Is_Visible);
+ pragma Inline (Make_Visible);
+ pragma Inline (Show_Line);
+ pragma Inline (Hide_Line);
+ pragma Inline (Show);
+ pragma Inline (Hide);
+
+ pragma Inline (Has_Icon);
+ pragma Inline (Get_Icon);
+
+ pragma Inline (Bounding_Box);
+ pragma Inline (Left_Edge);
+ pragma Inline (Redraw_Line);
+ pragma Inline (Redraw_List);
+
+ pragma Inline (Full_List_Height);
+ pragma Inline (Average_Item_Height);
+
+ pragma Inline (Item_Width);
+ pragma Inline (Item_Height);
+ pragma Inline (Item_First);
+ pragma Inline (Item_Last);
+ pragma Inline (Item_Next);
+ pragma Inline (Item_Previous);
+ pragma Inline (Item_At);
+ pragma Inline (Item_Select);
+ pragma Inline (Item_Swap);
+ pragma Inline (Item_Text);
+ pragma Inline (Item_Draw);
+
+ pragma Inline (Line_Number);
+
+
+end FLTK.Widgets.Groups.Browsers.Textline;
+
+
diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb
index 08ebd60..ea38b67 100644
--- a/src/fltk-widgets-groups-browsers.adb
+++ b/src/fltk-widgets-groups-browsers.adb
@@ -682,6 +682,35 @@ package body FLTK.Widgets.Groups.Browsers is
end Extra_Init;
+ procedure Initialize
+ (This : in out Browser) is
+ begin
+ This.Item_Inherit_Ptrs :=
+ (Current_Selection_Ptr => fl_abstract_browser_selection'Address,
+ Is_Displayed_Ptr => fl_abstract_browser_displayed'Address,
+ Find_Item_Ptr => fl_abstract_browser_find_item'Address,
+ Top_Item_Ptr => fl_abstract_browser_top'Address);
+ This.Redrawing_Ptrs :=
+ (Bounding_Box_Ptr => fl_abstract_browser_bbox'Address,
+ Left_Edge_Ptr => fl_abstract_browser_leftedge'Address,
+ Redraw_Line_Ptr => fl_abstract_browser_redraw_line'Address,
+ Redraw_List_Ptr => fl_abstract_browser_redraw_lines'Address);
+ This.Wide_High_Ptrs :=
+ (Full_List_Width_Ptr => fl_abstract_browser_full_width'Address,
+ Full_List_Height_Ptr => fl_abstract_browser_full_height'Address,
+ Average_Item_Height_Ptr => fl_abstract_browser_incr_height'Address,
+ Item_Quick_Height_Ptr => fl_abstract_browser_item_quick_height'Address);
+ This.Cache_Ptrs :=
+ (New_List_Ptr => fl_abstract_browser_new_list'Address,
+ Inserting_Ptr => fl_abstract_browser_inserting'Address,
+ Deleting_Ptr => fl_abstract_browser_deleting'Address,
+ Replacing_Ptr => fl_abstract_browser_replacing'Address,
+ Swapping_Ptr => fl_abstract_browser_swapping'Address);
+ This.Draw_Ptr := fl_abstract_browser_draw'Address;
+ This.Handle_Ptr := fl_abstract_browser_handle'Address;
+ end Initialize;
+
+
package body Forge is
function Create
@@ -801,9 +830,15 @@ package body FLTK.Widgets.Groups.Browsers is
function Current_Selection
(This : in Browser)
- return Item_Cursor is
+ return Item_Cursor
+ is
+ function my_selection
+ (V : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_selection'Address use This.Item_Inherit_Ptrs (Current_Selection_Ptr);
+ pragma Import (Ada, my_selection);
begin
- return Address_To_Cursor (fl_abstract_browser_selection (This.Void_Ptr));
+ return Address_To_Cursor (my_selection (This.Void_Ptr));
end Current_Selection;
@@ -850,9 +885,12 @@ package body FLTK.Widgets.Groups.Browsers is
Item : in Item_Cursor)
return Boolean
is
- Code : Interfaces.C.int := fl_abstract_browser_displayed
- (This.Void_Ptr,
- Cursor_To_Address (Item));
+ function my_displayed
+ (V, I : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_displayed'Address use This.Item_Inherit_Ptrs (Is_Displayed_Ptr);
+ pragma Import (Ada, my_displayed);
+ Code : Interfaces.C.int := my_displayed (This.Void_Ptr, Cursor_To_Address (Item));
begin
if Code not in 0 .. 1 then
raise Internal_FLTK_Error;
@@ -864,18 +902,30 @@ package body FLTK.Widgets.Groups.Browsers is
function Find_Item
(This : in Browser;
Y_Pos : in Integer)
- return Item_Cursor is
- begin
- return Address_To_Cursor
- (fl_abstract_browser_find_item (This.Void_Ptr, Interfaces.C.int (Y_Pos)));
+ return Item_Cursor
+ is
+ function my_find_item
+ (V : in Storage.Integer_Address;
+ N : in Interfaces.C.int)
+ return Storage.Integer_Address;
+ for my_find_item'Address use This.Item_Inherit_Ptrs (Find_Item_Ptr);
+ pragma Import (Ada, my_find_item);
+ begin
+ return Address_To_Cursor (my_find_item (This.Void_Ptr, Interfaces.C.int (Y_Pos)));
end Find_Item;
function Top_Item
(This : in Browser)
- return Item_Cursor is
+ return Item_Cursor
+ is
+ function my_top
+ (V : in Storage.Integer_Address)
+ return Storage.Integer_Address;
+ for my_top'Address use This.Item_Inherit_Ptrs (Top_Item_Ptr);
+ pragma Import (Ada, my_top);
begin
- return Address_To_Cursor (fl_abstract_browser_top (This.Void_Ptr));
+ return Address_To_Cursor (my_top (This.Void_Ptr));
end Top_Item;
@@ -1051,9 +1101,15 @@ package body FLTK.Widgets.Groups.Browsers is
procedure Bounding_Box
(This : in Browser;
- X, Y, W, H : out Integer) is
+ X, Y, W, H : out Integer)
+ is
+ procedure my_bbox
+ (V : in Storage.Integer_Address;
+ X, Y, W, H : out Interfaces.C.int);
+ for my_bbox'Address use This.Redrawing_Ptrs (Bounding_Box_Ptr);
+ pragma Import (Ada, my_bbox);
begin
- fl_abstract_browser_bbox
+ my_bbox
(This.Void_Ptr,
Interfaces.C.int (X),
Interfaces.C.int (Y),
@@ -1064,24 +1120,40 @@ package body FLTK.Widgets.Groups.Browsers is
function Left_Edge
(This : in Browser)
- return Integer is
+ return Integer
+ is
+ function my_leftedge
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_leftedge'Address use This.Redrawing_Ptrs (Left_Edge_Ptr);
+ pragma Import (Ada, my_leftedge);
begin
- return Integer (fl_abstract_browser_leftedge (This.Void_Ptr));
+ return Integer (my_leftedge (This.Void_Ptr));
end Left_Edge;
procedure Redraw_Line
(This : in out Browser;
- Item : in Item_Cursor) is
+ Item : in Item_Cursor)
+ is
+ procedure my_redraw_line
+ (V, I : in Storage.Integer_Address);
+ for my_redraw_line'Address use This.Redrawing_Ptrs (Redraw_Line_Ptr);
+ pragma Import (Ada, my_redraw_line);
begin
- fl_abstract_browser_redraw_line (This.Void_Ptr, Cursor_To_Address (Item));
+ my_redraw_line (This.Void_Ptr, Cursor_To_Address (Item));
end Redraw_Line;
procedure Redraw_List
- (This : in out Browser) is
+ (This : in out Browser)
+ is
+ procedure my_redraw_lines
+ (V : in Storage.Integer_Address);
+ for my_redraw_lines'Address use This.Redrawing_Ptrs (Redraw_List_Ptr);
+ pragma Import (Ada, my_redraw_lines);
begin
- fl_abstract_browser_redraw_lines (This.Void_Ptr);
+ my_redraw_lines (This.Void_Ptr);
end Redraw_List;
@@ -1091,34 +1163,58 @@ package body FLTK.Widgets.Groups.Browsers is
function Full_List_Width
(This : in Browser)
- return Integer is
+ return Integer
+ is
+ function my_full_width
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_full_width'Address use This.Wide_High_Ptrs (Full_List_Width_Ptr);
+ pragma Import (Ada, my_full_width);
begin
- return Integer (fl_abstract_browser_full_width (This.Void_Ptr));
+ return Integer (my_full_width (This.Void_Ptr));
end Full_List_Width;
function Full_List_Height
(This : in Browser)
- return Integer is
+ return Integer
+ is
+ function my_full_height
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_full_height'Address use This.Wide_High_Ptrs (Full_List_Height_Ptr);
+ pragma Import (Ada, my_full_height);
begin
- return Integer (fl_abstract_browser_full_height (This.Void_Ptr));
+ return Integer (my_full_height (This.Void_Ptr));
end Full_List_Height;
function Average_Item_Height
(This : in Browser)
- return Integer is
+ return Integer
+ is
+ function my_incr_height
+ (V : in Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_incr_height'Address use This.Wide_High_Ptrs (Average_Item_Height_Ptr);
+ pragma Import (Ada, my_incr_height);
begin
- return Integer (fl_abstract_browser_incr_height (This.Void_Ptr));
+ return Integer (my_incr_height (This.Void_Ptr));
end Average_Item_Height;
function Item_Quick_Height
(This : in Browser;
Item : in Item_Cursor)
- return Integer is
+ return Integer
+ is
+ function my_item_quick_height
+ (V, I : Storage.Integer_Address)
+ return Interfaces.C.int;
+ for my_item_quick_height'Address use This.Wide_High_Ptrs (Item_Quick_Height_Ptr);
+ pragma Import (Ada, my_item_quick_height);
begin
- return Integer (fl_abstract_browser_item_quick_height
+ return Integer (my_item_quick_height
(This.Void_Ptr,
Cursor_To_Address (Item)));
end Item_Quick_Height;
@@ -1227,17 +1323,27 @@ package body FLTK.Widgets.Groups.Browsers is
-- Cache invalidation
procedure New_List
- (This : in out Browser) is
+ (This : in out Browser)
+ is
+ procedure my_new_list
+ (V : in Storage.Integer_Address);
+ for my_new_list'Address use This.Cache_Ptrs (New_List_Ptr);
+ pragma Import (Ada, my_new_list);
begin
- fl_abstract_browser_new_list (This.Void_Ptr);
+ my_new_list (This.Void_Ptr);
end New_List;
procedure Inserting
(This : in out Browser;
- A, B : in Item_Cursor) is
+ A, B : in Item_Cursor)
+ is
+ procedure my_inserting
+ (V, A, B : in Storage.Integer_Address);
+ for my_inserting'Address use This.Cache_Ptrs (Inserting_Ptr);
+ pragma Import (Ada, my_inserting);
begin
- fl_abstract_browser_inserting
+ my_inserting
(This.Void_Ptr,
Cursor_To_Address (A),
Cursor_To_Address (B));
@@ -1246,9 +1352,14 @@ package body FLTK.Widgets.Groups.Browsers is
procedure Deleting
(This : in out Browser;
- Item : in Item_Cursor) is
+ Item : in Item_Cursor)
+ is
+ procedure my_deleting
+ (V, I : in Storage.Integer_Address);
+ for my_deleting'Address use This.Cache_Ptrs (Deleting_Ptr);
+ pragma Import (Ada, my_deleting);
begin
- fl_abstract_browser_deleting
+ my_deleting
(This.Void_Ptr,
Cursor_To_Address (Item));
end Deleting;
@@ -1256,9 +1367,14 @@ package body FLTK.Widgets.Groups.Browsers is
procedure Replacing
(This : in out Browser;
- A, B : in Item_Cursor) is
+ A, B : in Item_Cursor)
+ is
+ procedure my_replacing
+ (V, A, B : in Storage.Integer_Address);
+ for my_replacing'Address use This.Cache_Ptrs (Replacing_Ptr);
+ pragma Import (Ada, my_replacing);
begin
- fl_abstract_browser_replacing
+ my_replacing
(This.Void_Ptr,
Cursor_To_Address (A),
Cursor_To_Address (B));
@@ -1267,9 +1383,14 @@ package body FLTK.Widgets.Groups.Browsers is
procedure Swapping
(This : in out Browser;
- A, B : in Item_Cursor) is
+ A, B : in Item_Cursor)
+ is
+ procedure my_swapping
+ (V, A, B : in Storage.Integer_Address);
+ for my_swapping'Address use This.Cache_Ptrs (Swapping_Ptr);
+ pragma Import (Ada, my_swapping);
begin
- fl_abstract_browser_swapping
+ my_swapping
(This.Void_Ptr,
Cursor_To_Address (A),
Cursor_To_Address (B));
@@ -1281,19 +1402,30 @@ package body FLTK.Widgets.Groups.Browsers is
-- Standard Override API
procedure Draw
- (This : in out Browser) is
+ (This : in out Browser)
+ is
+ procedure my_draw
+ (V : in Storage.Integer_Address);
+ for my_draw'Address use This.Draw_Ptr;
+ pragma Import (Ada, my_draw);
begin
- fl_abstract_browser_draw (This.Void_Ptr);
+ my_draw (This.Void_Ptr);
end Draw;
function Handle
(This : in out Browser;
Event : in Event_Kind)
- return Event_Outcome is
- begin
- return Event_Outcome'Val
- (fl_abstract_browser_handle (This.Void_Ptr, Event_Kind'Pos (Event)));
+ return Event_Outcome
+ is
+ function my_handle
+ (V : in Storage.Integer_Address;
+ E : in Interfaces.C.int)
+ return Interfaces.C.int;
+ for my_handle'Address use This.Handle_Ptr;
+ pragma Import (Ada, my_handle);
+ begin
+ return Event_Outcome'Val (my_handle (This.Void_Ptr, Event_Kind'Pos (Event)));
end Handle;
diff --git a/src/fltk-widgets-groups-browsers.ads b/src/fltk-widgets-groups-browsers.ads
index 1ba16dd..1c511a9 100644
--- a/src/fltk-widgets-groups-browsers.ads
+++ b/src/fltk-widgets-groups-browsers.ads
@@ -351,13 +351,53 @@ package FLTK.Widgets.Groups.Browsers is
private
+ type Item_Override_Fun is
+ (Item_Width_Ptr, Item_Height_Ptr,
+ Item_First_Ptr, Item_Last_Ptr,
+ Item_Next_Ptr, Item_Previous_Ptr,
+ Item_At_Ptr, Item_Select_Ptr,
+ Item_Selected_Ptr, Item_Swap_Ptr,
+ Item_Text_Ptr, Item_Draw_Ptr);
+ type Item_Override_Fun_Ptr_Array is array (Item_Override_Fun) of System.Address;
+
+
+ type Item_Inherit_Fun is
+ (Current_Selection_Ptr, Is_Displayed_Ptr,
+ Find_Item_Ptr, Top_Item_Ptr);
+ type Item_Inherit_Fun_Ptr_Array is array (Item_Inherit_Fun) of System.Address;
+
+ type Redrawing_Fun is
+ (Bounding_Box_Ptr, Left_Edge_Ptr,
+ Redraw_Line_Ptr, Redraw_List_Ptr);
+ type Redrawing_Fun_Ptr_Array is array (Redrawing_Fun) of System.Address;
+
+ type Wide_High_Fun is
+ (Full_List_Width_Ptr, Full_List_Height_Ptr,
+ Average_Item_Height_Ptr, Item_Quick_Height_Ptr);
+ type Wide_High_Fun_Ptr_Array is array (Wide_High_Fun) of System.Address;
+
+ type Cache_Fun is
+ (New_List_Ptr, Inserting_Ptr,
+ Deleting_Ptr, Replacing_Ptr, Swapping_Ptr);
+ type Cache_Fun_Ptr_Array is array (Cache_Fun) of System.Address;
+
+
type Browser is new Group with record
- Horizon : aliased Valuators.Sliders.Scrollbars.Scrollbar;
- Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar;
- Text_Store : Interfaces.C.Strings.chars_ptr_array (1 .. 2);
- Current : Interfaces.C.size_t := 1;
+ Horizon : aliased Valuators.Sliders.Scrollbars.Scrollbar;
+ Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar;
+ Text_Store : Interfaces.C.Strings.chars_ptr_array (1 .. 2);
+ Current : Interfaces.C.size_t := 1;
+ Item_Inherit_Ptrs : Item_Inherit_Fun_Ptr_Array;
+ Redrawing_Ptrs : Redrawing_Fun_Ptr_Array;
+ Wide_High_Ptrs : Wide_High_Fun_Ptr_Array;
+ Cache_Ptrs : Cache_Fun_Ptr_Array;
+ Draw_Ptr : System.Address;
+ Handle_Ptr : System.Address;
end record;
+ overriding procedure Initialize
+ (This : in out Browser);
+
overriding procedure Finalize
(This : in out Browser);