mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-01 20:13:43 +02:00
1091 lines
28 KiB
ObjectPascal
1091 lines
28 KiB
ObjectPascal
(* GTK Demo for Pascal
|
|
*
|
|
* Welcome to GTK Demo for Pascal.
|
|
*
|
|
*
|
|
* This demo is an adaption of the GTK Demo included in the GTK+-2.0 source.
|
|
* A new feature is syntax highligting for pascal.
|
|
*)
|
|
|
|
program gtk_demo;
|
|
|
|
{$mode objfpc} {$H+}
|
|
uses glib2, pango, gdk2, gtk2, gdk2pixbuf, strings, math;
|
|
|
|
var
|
|
info_buffer : PGtkTextBuffer;
|
|
source_buffer : PGtkTextBuffer;
|
|
current_file : pgchar;
|
|
|
|
|
|
|
|
type
|
|
TFileOfChar = file of AnsiChar;
|
|
|
|
TGDoDemoFunc = function : PGtkWidget;
|
|
|
|
PDemo = ^TDemo;
|
|
TDemo = record
|
|
title : pgchar;
|
|
filename : pgchar;
|
|
func : TGDoDemoFunc;
|
|
children : PDemo;
|
|
end;
|
|
|
|
PCallbackData = ^TCallbackData;
|
|
TCallbackData = record
|
|
model : PGtkTreeModel;
|
|
path : PGtkTreePath;
|
|
end;
|
|
|
|
const
|
|
|
|
DEMO_DATA_DIR = 'data';
|
|
|
|
TITLE_COLUMN = 0;
|
|
FILENAME_COLUMN = 1;
|
|
FUNC_COLUMN = 2;
|
|
ITALIC_COLUMN = 3;
|
|
NUM_COLUMNS = 4;
|
|
|
|
STATE_NORMAL = 0;
|
|
STATE_IN_COMMENT = 1;
|
|
|
|
function demo_find_file ( base : PAnsiChar; err : PPGError): pgchar; forward;
|
|
|
|
(* file_is_valid
|
|
* a dirty little hack to find out if a file variable is assigned and the
|
|
* file is opened.
|
|
*)
|
|
function file_is_valid (var f: file): boolean;
|
|
begin
|
|
{$push}{$I-}
|
|
if eof(f) then
|
|
exit (TRUE);
|
|
{$pop}
|
|
if IOResult <> 0 then
|
|
file_is_valid := FALSE
|
|
else
|
|
file_is_valid := TRUE;
|
|
end;
|
|
|
|
(* min, max
|
|
* these two functions of the math unit are overloaded to understand double
|
|
* values.
|
|
*)
|
|
function min (d1, d2: double): double;
|
|
begin
|
|
if d1 > d2 then min := d2
|
|
else min := d1;
|
|
end;
|
|
|
|
function max (d1, d2: double): double;
|
|
begin
|
|
if d1 < d2 then max := d2
|
|
else max := d1;
|
|
end;
|
|
|
|
(* do_dummy
|
|
* creates a widget informing the user that the demo isn't implemented, yet
|
|
*)
|
|
|
|
procedure do_dummy (demo : pgchar);
|
|
var
|
|
dialog : PGtkWidget;
|
|
begin
|
|
dialog := gtk_message_dialog_new (NULL, 0,
|
|
GTK_MESSAGE_INFO,
|
|
GTK_BUTTONS_CLOSE,
|
|
'Sorry, "%s" is''t implemented, yet.',
|
|
[demo]);
|
|
|
|
gtk_widget_show (dialog);
|
|
|
|
g_signal_connect (dialog, 'response',
|
|
G_CALLBACK (@gtk_widget_destroy), NULL);
|
|
end;
|
|
|
|
(* include the modules here;
|
|
* if you'd like to add one add the include command and
|
|
* create a new entry in the testgtk_demos array
|
|
*)
|
|
|
|
{$include appwindow.inc}
|
|
{$include button_box.inc}
|
|
{$include colorsel.inc}
|
|
{$include dialog.inc}
|
|
{$include drawingarea.inc}
|
|
{$include editable_cells.inc}
|
|
{$include images.inc}
|
|
{$include item_factory.inc}
|
|
{$include list_store.inc}
|
|
{$include menus.inc}
|
|
{$include panes.inc}
|
|
{$include pixbufs.inc}
|
|
{$include sizegroup.inc}
|
|
{$include stock_browser.inc}
|
|
{$include textview.inc}
|
|
{$include tree_store.inc}
|
|
|
|
|
|
const
|
|
child0 : array [1..4] of TDemo = (
|
|
(title: 'Editable Cells'; filename: 'editable_cells.inc'; func: @do_editable_cells; children: nil),
|
|
(title: 'List Store'; filename: 'list_store.inc'; func: @do_list_store; children: nil),
|
|
(title: 'Tree Store'; filename: 'tree_store.inc'; func: @do_tree_store; children: nil),
|
|
(title: nil; filename: nil; func: nil; children: nil));
|
|
|
|
testgtk_demos: array [1..16] of TDemo = (
|
|
(title: '* This Application *'; filename: 'gtk_demo.pas'; func: nil; children: nil),
|
|
(title: 'Application main window'; filename: 'appwindow.inc'; func: @do_appwindow; children: nil),
|
|
(title: 'Button Boxes'; filename: 'button_box.inc'; func: @do_button_box; children: nil),
|
|
(title: 'Color Selector'; filename: 'colorsel.inc'; func: @do_colorsel; children: nil),
|
|
(title: 'Dialog and Message Boxes'; filename: 'dialog.inc'; func: @do_dialog; children: nil),
|
|
(title: 'Drawing Area'; filename: 'drawingarea.inc'; func: @do_drawingarea; children: nil),
|
|
(title: 'Images'; filename: 'images.inc'; func: @do_images; children: nil),
|
|
(title: 'Item Factory'; filename: 'item_factory.inc'; func: @do_item_factory; children: nil),
|
|
(title: 'Menus'; filename: 'menus.inc'; func: @do_menus; children: nil),
|
|
(title: 'Paned Widgets'; filename: 'panes.inc'; func: @do_panes; children: nil),
|
|
(title: 'Pixbufs'; filename: 'pixbufs.inc'; func: @do_pixbufs; children: nil),
|
|
(title: 'Size Groups'; filename: 'sizegroup.inc'; func: @do_sizegroup; children: nil),
|
|
(title: 'Stock Item and Icon Browser'; filename: 'stock_browser.inc'; func: @do_stock_browser; children: nil),
|
|
(title: 'Text Widget'; filename: 'textview.inc'; func: @do_textview; children: nil),
|
|
(title: 'Tree View'; filename: nil; func: nil; children: @child0),
|
|
(title: nil; filename: nil; func: nil; children: nil));
|
|
|
|
|
|
function demo_find_file ( base : PAnsiChar;
|
|
err : PPGError): pgchar;
|
|
var
|
|
filename : PAnsiChar;
|
|
|
|
begin
|
|
|
|
if g_file_test (base, G_FILE_TEST_EXISTS) then begin
|
|
demo_find_file := g_strdup (base);
|
|
exit;
|
|
end else
|
|
begin
|
|
filename := g_build_filename (DEMO_DATA_DIR, [ base, NULL ]);
|
|
|
|
if not (g_file_test (filename, G_FILE_TEST_EXISTS)) then
|
|
begin
|
|
g_set_error (err, G_FILE_ERROR, G_FILE_ERROR_NOENT,
|
|
'Cannot find demo data file "%s"', [base]);
|
|
g_free (filename);
|
|
demo_find_file := NULL;
|
|
end else
|
|
demo_find_file := filename;
|
|
end;
|
|
end;
|
|
|
|
|
|
function create_text (var buffer : PGtkTextBuffer;
|
|
is_source : gboolean): PGtkWidget;
|
|
var
|
|
scrolled_window,
|
|
text_view : PGtkWidget;
|
|
|
|
font_desc : PPangoFontDescription;
|
|
|
|
begin
|
|
scrolled_window := gtk_scrolled_window_new (NULL, NULL);
|
|
|
|
gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (scrolled_window),
|
|
GTK_POLICY_AUTOMATIC,
|
|
GTK_POLICY_AUTOMATIC);
|
|
|
|
gtk_scrolled_window_set_shadow_type (GTK_SCROLLED_WINDOW (scrolled_window),
|
|
GTK_SHADOW_IN);
|
|
|
|
text_view := gtk_text_view_new;
|
|
|
|
buffer := gtk_text_buffer_new (NULL);
|
|
|
|
gtk_text_view_set_buffer (GTK_TEXT_VIEW (text_view), buffer);
|
|
gtk_text_view_set_editable (GTK_TEXT_VIEW (text_view), FALSE);
|
|
gtk_text_view_set_cursor_visible (GTK_TEXT_VIEW (text_view), FALSE);
|
|
|
|
gtk_container_add (GTK_CONTAINER (scrolled_window), text_view);
|
|
|
|
if is_source then
|
|
begin
|
|
font_desc := pango_font_description_from_string ('Courier 12');
|
|
gtk_widget_modify_font (text_view, font_desc);
|
|
pango_font_description_free (font_desc);
|
|
|
|
gtk_text_view_set_wrap_mode (GTK_TEXT_VIEW (text_view),
|
|
GTK_WRAP_NONE);
|
|
end else
|
|
begin
|
|
(* Make it a bit nicer for text. *)
|
|
gtk_text_view_set_wrap_mode (GTK_TEXT_VIEW (text_view),
|
|
GTK_WRAP_WORD);
|
|
gtk_text_view_set_pixels_above_lines (GTK_TEXT_VIEW (text_view), 2);
|
|
gtk_text_view_set_pixels_below_lines (GTK_TEXT_VIEW (text_view), 2);
|
|
end;
|
|
|
|
create_text := scrolled_window;
|
|
end;
|
|
|
|
|
|
const
|
|
tokens: array [1..4] of pgchar =
|
|
('(*',
|
|
'''',
|
|
'{',
|
|
'//');
|
|
|
|
types: array [1..57] of pgchar =
|
|
('integer',
|
|
'gchar',
|
|
'pgchar',
|
|
'AnsiChar',
|
|
'gfloat',
|
|
'real',
|
|
'gint8',
|
|
'gint16',
|
|
'gint32',
|
|
'gint',
|
|
'guint',
|
|
'guint8',
|
|
'guint16',
|
|
'guint32',
|
|
'guchar',
|
|
'glong',
|
|
'longint',
|
|
'gboolean' ,
|
|
'gshort',
|
|
'gushort',
|
|
'gulong',
|
|
'gdouble',
|
|
'double',
|
|
'gldouble',
|
|
'gpointer',
|
|
'pointer',
|
|
'NULL',
|
|
'nil',
|
|
'PGList',
|
|
'TGList',
|
|
'TGSList',
|
|
'PGSList',
|
|
'FALSE',
|
|
'TRUE',
|
|
'PGtkObject',
|
|
'TGtkObject',
|
|
'TGtkColorSelection',
|
|
'PGtkColorSelection',
|
|
'PGtkWidget',
|
|
'TGtkWidget',
|
|
'PGtkButton',
|
|
'TGtkButton',
|
|
'TGdkColor',
|
|
'PGdkColor',
|
|
'TGdkRectangle',
|
|
'PGdkRectangle',
|
|
'TGdkEventExpose',
|
|
'PGdkEventExpose',
|
|
'TGdkGC',
|
|
'PGdkGC',
|
|
'TGdkPixbufLoader',
|
|
'PGdkPixbufLoader',
|
|
'TGdkPixbuf',
|
|
'PGdkPixbuf',
|
|
'PPGError',
|
|
'PGError',
|
|
'array');
|
|
|
|
control: array [1..23] of pgchar = (
|
|
'if',
|
|
'then',
|
|
'case',
|
|
'while',
|
|
'else',
|
|
'do',
|
|
'for',
|
|
'begin',
|
|
'end',
|
|
'exit',
|
|
'goto',
|
|
'program',
|
|
'unit',
|
|
'library',
|
|
'procedure',
|
|
'function',
|
|
'type',
|
|
'var',
|
|
'const',
|
|
'record',
|
|
'uses',
|
|
'of',
|
|
'in');
|
|
|
|
procedure parse_chars ( text : pgchar;
|
|
var end_ptr : pgchar;
|
|
var state : gint;
|
|
var tag : pgchar;
|
|
start : gboolean);
|
|
var
|
|
i : gint;
|
|
next_token : pgchar;
|
|
|
|
maybe_escape : boolean;
|
|
begin
|
|
(* leave out leading spaces *)
|
|
while (text^ <> #0) and (g_ascii_isspace (text^)) do
|
|
inc (text);
|
|
|
|
(* Handle comments first *)
|
|
|
|
if state = STATE_IN_COMMENT then
|
|
begin
|
|
end_ptr := StrPos (text, '*)');
|
|
next_token := StrPos (text, '}');
|
|
|
|
if next_token > end_ptr then begin
|
|
end_ptr := next_token + 1; // '}' comment type
|
|
state := STATE_NORMAL;
|
|
tag := 'comment';
|
|
end else
|
|
if end_ptr <> NULL then
|
|
begin
|
|
end_ptr := end_ptr + 2; // '* )' comment type
|
|
state := STATE_NORMAL;
|
|
tag := 'comment';
|
|
end;
|
|
|
|
exit;
|
|
end;
|
|
|
|
tag := NULL;
|
|
end_ptr := NULL;
|
|
|
|
if text^ = #0 then
|
|
exit;
|
|
|
|
(* check for preprocessor defines *)
|
|
|
|
if (((StrLComp (text, '(*', 2)) = 0) and (text[2] = '$') ) or
|
|
(((StrLComp (text, '{', 1)) = 0) and (text[1] = '$') ) then
|
|
begin
|
|
end_ptr := StrPos (text, '*)');
|
|
next_token := StrPos (text, '}');
|
|
|
|
if next_token > end_ptr then
|
|
end_ptr := next_token + 1
|
|
else
|
|
if end_ptr <> NULL then
|
|
end_ptr := end_ptr + 2;
|
|
|
|
tag := 'preprocessor';
|
|
exit;
|
|
end;
|
|
|
|
|
|
|
|
(* check for comment *)
|
|
|
|
if ((StrLComp (text, '(*', 2)) = 0) or
|
|
((StrLComp (text, '{', 1)) = 0) then
|
|
begin
|
|
end_ptr := StrPos (text, '*)');
|
|
next_token := StrPos (text, '}');
|
|
|
|
if next_token > end_ptr then
|
|
end_ptr := next_token+1
|
|
else begin
|
|
if end_ptr <> NULL then
|
|
end_ptr := end_ptr + 2
|
|
else
|
|
state := STATE_IN_COMMENT;
|
|
end;
|
|
tag := 'comment';
|
|
exit;
|
|
end;
|
|
|
|
if (StrLComp (text, '//', 2)) = 0 then
|
|
begin
|
|
end_ptr := NULL;
|
|
tag := 'comment';
|
|
exit;
|
|
end;
|
|
|
|
(* check for types *)
|
|
|
|
for i := 1 to high (types) do
|
|
if ((StrLComp (text, types[i], strlen (types[i]))) = 0 ) and
|
|
((text+strlen(types[i]))^ in [#8, #32, #0, ';', #13, #10, ')', ']', ':']) then
|
|
begin
|
|
end_ptr := text + strlen (types[i]);
|
|
tag := 'type';
|
|
exit;
|
|
end;
|
|
|
|
(* check for control *)
|
|
for i := 1 to high (control) do begin
|
|
if ((StrLComp (text, control[i], strlen (control[i]))) = 0) and
|
|
((text+strlen(control[i]))^ in [#8, #32, #0, ';', #13, #10, ')', ']', ':']) then
|
|
begin
|
|
end_ptr := text + strlen (control[i]);
|
|
tag := 'control';
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
(* check for string *)
|
|
if text^= '''' then
|
|
begin
|
|
maybe_escape := FALSE;
|
|
|
|
end_ptr := text + 1;
|
|
tag := 'string';
|
|
|
|
while end_ptr^ <> #0 do
|
|
begin
|
|
if (end_ptr^ = '''') and (maybe_escape = FALSE) then
|
|
begin
|
|
inc (end_ptr);
|
|
exit;
|
|
end;
|
|
|
|
if end_ptr^ = '\' then
|
|
maybe_escape := TRUE
|
|
else
|
|
maybe_escape := FALSE;
|
|
|
|
inc (end_ptr);
|
|
end;
|
|
exit;
|
|
end;
|
|
|
|
|
|
(* not at the start of a tag. Find the next one. *)
|
|
for i := 1 to high(tokens) do
|
|
begin
|
|
next_token := StrPos (text, tokens[i]);
|
|
if next_token <> NULL then
|
|
begin
|
|
if end_ptr <> NULL then
|
|
begin
|
|
if end_ptr > next_token then
|
|
end_ptr := next_token;
|
|
end else
|
|
end_ptr := next_token;
|
|
end;
|
|
end;
|
|
|
|
for i := 1 to high(types) do
|
|
begin
|
|
next_token := StrPos (text, types[i]);
|
|
if next_token <> NULL then
|
|
if ( (next_token+strlen(types[i]))^
|
|
in [#8, #32, #0, ';', #13, #10, ')', ']', ':']) and
|
|
g_ascii_isspace ((next_token-1)^) then
|
|
begin
|
|
if end_ptr <> NULL then
|
|
begin
|
|
if end_ptr > next_token then
|
|
end_ptr := next_token;
|
|
end else
|
|
end_ptr := next_token;
|
|
end;
|
|
end;
|
|
|
|
|
|
for i := 1 to high(control) do
|
|
begin
|
|
next_token := StrPos (text, control[i]);
|
|
if next_token <> NULL then
|
|
if ( (next_token+strlen(control[i]))^
|
|
in [#8, #32, #0, ';', #13, #10, ')', ']', ':']) and
|
|
g_ascii_isspace ((next_token-1)^) then
|
|
begin
|
|
if end_ptr <> NULL then
|
|
begin
|
|
if end_ptr > next_token then
|
|
end_ptr := next_token;
|
|
end else
|
|
end_ptr := next_token;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
(* While not as cool as c-mode, this will do as a quick attempt at highlighting *)
|
|
|
|
procedure fontify;
|
|
|
|
var
|
|
start_iter,
|
|
next_iter,
|
|
tmp_iter : TGtkTextIter;
|
|
|
|
state : gint;
|
|
text : pgchar;
|
|
start_ptr,
|
|
|
|
end_ptr : pgchar;
|
|
tag : pgchar;
|
|
start : gboolean;
|
|
|
|
begin
|
|
state := STATE_NORMAL;
|
|
|
|
gtk_text_buffer_get_iter_at_offset (source_buffer, @start_iter, 0);
|
|
|
|
next_iter := start_iter;
|
|
|
|
while (gtk_text_iter_forward_line (@next_iter)) do
|
|
begin
|
|
start := TRUE;
|
|
text := gtk_text_iter_get_text ( @start_iter, @next_iter);
|
|
start_ptr := text;
|
|
|
|
repeat
|
|
parse_chars (start_ptr, end_ptr, state, tag, start);
|
|
|
|
start := FALSE;
|
|
if end_ptr <> NULL then begin
|
|
tmp_iter := start_iter;
|
|
gtk_text_iter_forward_chars (@tmp_iter, end_ptr - start_ptr);
|
|
end else
|
|
tmp_iter := next_iter;
|
|
|
|
if tag <> NULL then
|
|
gtk_text_buffer_apply_tag_by_name (source_buffer, tag, @start_iter, @tmp_iter);
|
|
|
|
start_iter := tmp_iter;
|
|
start_ptr := end_ptr;
|
|
until end_ptr = NULL;
|
|
|
|
g_free (text);
|
|
start_iter := next_iter;
|
|
end;
|
|
end;
|
|
|
|
function read_line (var f: TFileOfChar; str: PGString): boolean;
|
|
var
|
|
n_read : integer;
|
|
c,
|
|
next_c : AnsiChar;
|
|
|
|
begin
|
|
n_read := 0;
|
|
|
|
g_string_truncate (str, 0);
|
|
|
|
while not eof(f) do begin
|
|
read (f, c);
|
|
|
|
inc (n_read);
|
|
|
|
if (c = #10) or (c = #13) then
|
|
begin
|
|
if not eof(f) then
|
|
begin
|
|
read (f, next_c);
|
|
|
|
if not ((next_c in [#13, #10]) and (c <> next_c)) then
|
|
seek(f, filepos(f)-1);
|
|
break;
|
|
end;
|
|
end else
|
|
g_string_append_c (str, c);
|
|
end;
|
|
|
|
read_line := n_read > 0;
|
|
end;
|
|
|
|
|
|
|
|
(* opens a textfile and reads it into the TGtkTextBuffer *)
|
|
procedure load_file (filename : pgchar);
|
|
|
|
var
|
|
text_start,
|
|
text_end : TGtkTextIter;
|
|
|
|
err : PGError;
|
|
buffer : PGString;
|
|
state,
|
|
len_chars,
|
|
len : integer;
|
|
|
|
in_para : gboolean;
|
|
f : TFileOfChar;
|
|
full_name : PAnsiChar;
|
|
p, q, r : pgchar;
|
|
|
|
begin
|
|
|
|
err := NULL;
|
|
buffer := g_string_new (NULL);
|
|
state := 0;
|
|
in_para := FALSE;
|
|
|
|
if (current_file <> NULL) and (StrComp (current_file, filename) = 0) then begin
|
|
g_string_free (buffer, TRUE);
|
|
exit;
|
|
end;
|
|
|
|
g_free (current_file);
|
|
current_file := g_strdup (filename);
|
|
|
|
gtk_text_buffer_get_bounds (info_buffer, @text_start, @text_end);
|
|
gtk_text_buffer_delete (info_buffer, @text_start, @text_end);
|
|
|
|
gtk_text_buffer_get_bounds (source_buffer, @text_start, @text_end);
|
|
gtk_text_buffer_delete (source_buffer, @text_start, @text_end);
|
|
|
|
full_name := demo_find_file (filename, @err);
|
|
|
|
if full_name = NULL then begin
|
|
g_warning ('%s', [err^.message]);
|
|
g_error_free (err);
|
|
exit;
|
|
end;
|
|
|
|
{$push}{$I-}
|
|
assign (f, full_name);
|
|
reset (f);
|
|
{$pop}
|
|
|
|
if IOResult <> 0 then
|
|
g_print ('Cannot open %s: file not found'#13#10, [full_name]);
|
|
|
|
g_free (full_name);
|
|
|
|
if IOResult <> 0 then
|
|
exit;
|
|
|
|
gtk_text_buffer_get_iter_at_offset (info_buffer, @text_start, 0);
|
|
|
|
while read_line (f, buffer) do
|
|
begin
|
|
p := buffer^.str;
|
|
|
|
case state of
|
|
0 : begin (* Reading title *)
|
|
|
|
while (((p^ = '(') or (p^ = '*')) or (p^ = '{')) or g_ascii_isspace (p^) do
|
|
inc (p);
|
|
r := p;
|
|
|
|
while (r^ <> ')') and (strlen (r) > 0) do
|
|
inc (r);
|
|
|
|
if strlen (r) > 0 then
|
|
p := r + 1;
|
|
|
|
q := p + strlen (p);
|
|
|
|
while (q > p) and g_ascii_isspace ((q - 1)^) do
|
|
dec(q);
|
|
|
|
if q > p then
|
|
begin
|
|
len_chars := g_utf8_pointer_to_offset (p, q);
|
|
|
|
text_end := text_start;
|
|
|
|
// g_assert (strlen (p) >= (q - p));
|
|
|
|
gtk_text_buffer_insert (info_buffer, @text_end, p, q - p);
|
|
text_start := text_end;
|
|
|
|
gtk_text_iter_backward_chars (@text_start, len_chars);
|
|
gtk_text_buffer_apply_tag_by_name (info_buffer, 'title', @text_start, @text_end);
|
|
|
|
text_start := text_end;
|
|
|
|
inc (state);
|
|
end; {of q > p }
|
|
end; {of state = 0}
|
|
|
|
|
|
1: begin (* Reading body of info section *)
|
|
while g_ascii_isspace (p^) do
|
|
inc(p);
|
|
|
|
if (p^ = '*') and ((p + 1)^ = ')') then
|
|
begin
|
|
gtk_text_buffer_get_iter_at_offset (source_buffer, @text_start, 0);
|
|
inc(state);
|
|
end else
|
|
begin
|
|
while (p^ = '*') or g_ascii_isspace (p^) do
|
|
inc(p);
|
|
|
|
len := strlen (p);
|
|
|
|
while g_ascii_isspace ( (p + len - 1)^) do
|
|
dec (len);
|
|
|
|
if len > 0 then
|
|
begin
|
|
|
|
if in_para then
|
|
gtk_text_buffer_insert (info_buffer, @text_start, ' ', 1);
|
|
|
|
// g_assert (strlen (p) >= len);
|
|
|
|
gtk_text_buffer_insert (info_buffer, @text_start, p, len);
|
|
|
|
in_para := TRUE;
|
|
end else
|
|
begin
|
|
gtk_text_buffer_insert (info_buffer, @text_start, #10, 1);
|
|
in_para := FALSE;
|
|
end; {else len <= 0}
|
|
end;
|
|
end;
|
|
2: begin (* Skipping blank lines *)
|
|
while g_ascii_isspace (p^) do
|
|
inc(p);
|
|
|
|
if p^ <> #0 then
|
|
begin
|
|
p := buffer^.str;
|
|
inc (state); (* Fall through *)
|
|
|
|
(* Reading program body *)
|
|
gtk_text_buffer_insert (source_buffer, @text_start, p, -1);
|
|
gtk_text_buffer_insert (source_buffer, @text_start, #10, 1);
|
|
end;
|
|
end;
|
|
|
|
3: begin (* Reading program body *)
|
|
gtk_text_buffer_insert (source_buffer, @text_start, p, -1);
|
|
gtk_text_buffer_insert (source_buffer, @text_start, #10, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
close (f);
|
|
fontify ();
|
|
|
|
g_string_free (buffer, TRUE);
|
|
end;
|
|
|
|
(* some callbacks *)
|
|
|
|
procedure window_closed_cb (window : PGtkWidget;
|
|
data : gpointer); cdecl;
|
|
var
|
|
cbdata : PCallbackData;
|
|
iter : TGtkTreeIter;
|
|
italic,
|
|
nitalic : gboolean;
|
|
|
|
begin
|
|
cbdata := data;
|
|
|
|
gtk_tree_model_get_iter (cbdata^.model, @iter, cbdata^.path);
|
|
gtk_tree_model_get (GTK_TREE_MODEL (cbdata^.model), @iter,
|
|
[ ITALIC_COLUMN, @italic, -1] );
|
|
nitalic := not italic;
|
|
|
|
if italic then
|
|
gtk_tree_store_set (GTK_TREE_STORE (cbdata^.model), @iter,
|
|
[ ITALIC_COLUMN, nitalic, -1] );
|
|
|
|
gtk_tree_path_free (cbdata^.path);
|
|
dispose (cbdata);
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure row_activated_cb (tree_view : PGtkTreeView;
|
|
path : PGtkTreePath;
|
|
column : PGtkTreeViewColumn); cdecl;
|
|
var
|
|
iter : TGtkTreeIter;
|
|
italic,
|
|
nitalic : gboolean;
|
|
func : TGDoDemoFunc;
|
|
window : PGtkWidget;
|
|
model : PGtkTreeModel;
|
|
cbdata : PCallbackData;
|
|
|
|
begin
|
|
model := gtk_tree_view_get_model (tree_view);
|
|
|
|
gtk_tree_model_get_iter (model, @iter, path);
|
|
gtk_tree_model_get (GTK_TREE_MODEL (model),
|
|
@iter,
|
|
[ FUNC_COLUMN, @func,
|
|
ITALIC_COLUMN, @italic, -1 ]);
|
|
|
|
if func <> NULL then
|
|
begin
|
|
nitalic := not italic;
|
|
gtk_tree_store_set (GTK_TREE_STORE (model),
|
|
@iter,
|
|
[ ITALIC_COLUMN, nitalic, -1 ] );
|
|
|
|
window := func();
|
|
|
|
if window <> NULL then
|
|
begin
|
|
new (cbdata);
|
|
cbdata^.model := model;
|
|
|
|
cbdata^.path := gtk_tree_path_copy (path);
|
|
|
|
g_signal_connect (window, 'destroy',
|
|
G_CALLBACK (@window_closed_cb), cbdata );
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure selection_cb ( selection : PGtkTreeSelection;
|
|
model : PGtkTreeModel); cdecl;
|
|
var
|
|
iter : TGtkTreeIter;
|
|
// value : TGValue;
|
|
str : pgchar;
|
|
|
|
begin
|
|
|
|
(* g_value_init(@value, G_TYPE_STRING); // added to test if TGValue works
|
|
// -- its seems not as if it does *)
|
|
|
|
if not gtk_tree_selection_get_selected (selection, NULL, @iter) then
|
|
exit;
|
|
|
|
(* The original code used TGValue but it seems not to work; check why *)
|
|
|
|
(*
|
|
gtk_tree_model_get_value (model, @iter, FILENAME_COLUMN, @value);
|
|
|
|
if (g_value_get_string (@value)) <> NULL then
|
|
load_file (g_value_get_string (@value));
|
|
|
|
g_value_unset (@value);
|
|
*)
|
|
|
|
gtk_tree_model_get (model, @iter, [FILENAME_COLUMN, @str, -1]);
|
|
|
|
if str <> NULL then
|
|
load_file (str);
|
|
|
|
end;
|
|
|
|
|
|
function create_tree: PGtkWidget;
|
|
|
|
var
|
|
selection : PGtkTreeSelection;
|
|
cell : PGtkCellRenderer;
|
|
tree_view : PGtkWidget;
|
|
column : PGtkTreeViewColumn;
|
|
model : PGtkTreeStore;
|
|
|
|
iter,
|
|
child_iter : TGtkTreeIter;
|
|
|
|
d,
|
|
children : PDemo;
|
|
|
|
begin
|
|
d := @testgtk_demos;
|
|
|
|
model := gtk_tree_store_new (NUM_COLUMNS, [G_TYPE_STRING, G_TYPE_STRING, G_TYPE_POINTER, G_TYPE_BOOLEAN]);
|
|
|
|
tree_view := gtk_tree_view_new ();
|
|
|
|
gtk_tree_view_set_model (GTK_TREE_VIEW (tree_view), GTK_TREE_MODEL (model));
|
|
selection := gtk_tree_view_get_selection (GTK_TREE_VIEW (tree_view));
|
|
|
|
gtk_tree_selection_set_mode (GTK_TREE_SELECTION (selection),
|
|
GTK_SELECTION_BROWSE);
|
|
|
|
gtk_widget_set_size_request (tree_view, 200, -1);
|
|
|
|
(* this code only supports 1 level of children. If we
|
|
* want more we probably have to use a recursing function.
|
|
*)
|
|
|
|
|
|
while d^.title <> NULL do begin
|
|
children := d^.children;
|
|
|
|
gtk_tree_store_append (GTK_TREE_STORE (model), @iter, NULL);
|
|
|
|
gtk_tree_store_set (GTK_TREE_STORE (model),
|
|
@iter,
|
|
[ TITLE_COLUMN, d^.title,
|
|
FILENAME_COLUMN, d^.filename,
|
|
FUNC_COLUMN, d^.func,
|
|
ITALIC_COLUMN, FALSE, -1 ] );
|
|
|
|
inc(d);
|
|
|
|
if children = NULL then
|
|
continue;
|
|
|
|
while children^.title <> NULL do begin
|
|
|
|
gtk_tree_store_append (GTK_TREE_STORE (model), @child_iter, @iter);
|
|
|
|
gtk_tree_store_set (GTK_TREE_STORE (model),
|
|
@child_iter,
|
|
[TITLE_COLUMN, children^.title,
|
|
FILENAME_COLUMN, children^.filename,
|
|
FUNC_COLUMN, children^.func,
|
|
ITALIC_COLUMN, FALSE, -1]);
|
|
inc (children);
|
|
end;
|
|
end;
|
|
|
|
cell := gtk_cell_renderer_text_new ();
|
|
|
|
g_object_set (G_OBJECT (cell),
|
|
'style', [ PANGO_STYLE_ITALIC, NULL ]);
|
|
|
|
|
|
column := gtk_tree_view_column_new_with_attributes ('Widget (double click for demo)',
|
|
cell,
|
|
[ 'text', TITLE_COLUMN,
|
|
'style_set', ITALIC_COLUMN, NULL ] );
|
|
|
|
gtk_tree_view_append_column (GTK_TREE_VIEW (tree_view),
|
|
GTK_TREE_VIEW_COLUMN (column));
|
|
|
|
g_signal_connect (selection, 'changed', G_CALLBACK (@selection_cb), model);
|
|
g_signal_connect (tree_view, 'row_activated', G_CALLBACK (@row_activated_cb), model);
|
|
|
|
gtk_tree_view_expand_all (GTK_TREE_VIEW (tree_view));
|
|
|
|
create_tree := tree_view;
|
|
end;
|
|
|
|
|
|
procedure setup_default_icon;
|
|
var
|
|
pixbuf : PGdkPixbuf;
|
|
filename : PAnsiChar;
|
|
err : PGError;
|
|
|
|
dialog : PGtkWidget;
|
|
|
|
list : PGList;
|
|
transparent : PGdkPixbuf;
|
|
|
|
begin
|
|
err := NULL;
|
|
pixbuf := NULL;
|
|
dialog := NULL;
|
|
|
|
filename := demo_find_file ('gtk-logo-rgb.gif', @err);
|
|
|
|
if filename <> NULL then
|
|
begin
|
|
pixbuf := gdk_pixbuf_new_from_file (filename, @err);
|
|
g_free (filename);
|
|
end;
|
|
|
|
(* Ignoring this error (passing NULL instead of &err above)
|
|
* would probably be reasonable for most apps. We're just
|
|
* showing off.
|
|
*)
|
|
|
|
if err <> NULL then
|
|
begin
|
|
dialog := gtk_message_dialog_new (NULL, 0,
|
|
GTK_MESSAGE_ERROR,
|
|
GTK_BUTTONS_CLOSE,
|
|
'Failed to read icon file: %s',
|
|
[err^.message]);
|
|
gtk_widget_show (dialog);
|
|
g_error_free (err);
|
|
|
|
g_signal_connect (dialog, 'response',
|
|
G_CALLBACK (@gtk_widget_destroy), NULL);
|
|
end;
|
|
|
|
if pixbuf <> NULL then
|
|
begin
|
|
(* The gtk-logo-rgb icon has a white background, make it transparent *)
|
|
|
|
transparent := gdk_pixbuf_add_alpha (pixbuf, TRUE, $ff, $ff, $ff);
|
|
|
|
list := NULL;
|
|
list := g_list_append (list, transparent);
|
|
|
|
gtk_window_set_default_icon_list (list);
|
|
|
|
g_list_free (list);
|
|
g_object_unref (G_OBJECT (pixbuf));
|
|
g_object_unref (G_OBJECT (transparent));
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
window,
|
|
notebook,
|
|
hbox,
|
|
tree : PGtkWidget;
|
|
|
|
begin
|
|
current_file := NULL;
|
|
|
|
{$include init.inc} (* contains all variable inits of the demos *)
|
|
|
|
gtk_init (@argc, @argv);
|
|
|
|
setup_default_icon ();
|
|
|
|
window := gtk_window_new (GTK_WINDOW_TOPLEVEL);
|
|
|
|
gtk_window_set_title (GTK_WINDOW (window), 'GTK+ Code Demos');
|
|
|
|
g_signal_connect (window, 'destroy',
|
|
G_CALLBACK (@gtk_main_quit), NULL);
|
|
|
|
hbox := gtk_hbox_new (FALSE, 0);
|
|
gtk_container_add (GTK_CONTAINER (window), hbox);
|
|
|
|
tree := create_tree;
|
|
|
|
gtk_box_pack_start (GTK_BOX (hbox), tree, FALSE, FALSE, 0);
|
|
|
|
notebook := gtk_notebook_new;
|
|
gtk_box_pack_start (GTK_BOX (hbox), notebook, TRUE, TRUE, 0);
|
|
|
|
gtk_notebook_append_page (GTK_NOTEBOOK (notebook),
|
|
create_text (info_buffer, FALSE),
|
|
gtk_label_new_with_mnemonic ('_Info'));
|
|
|
|
|
|
gtk_notebook_append_page (GTK_NOTEBOOK (notebook),
|
|
create_text (source_buffer, TRUE),
|
|
gtk_label_new_with_mnemonic ('_Source'));
|
|
|
|
gtk_text_buffer_create_tag (info_buffer, 'title', 'font', ['Sans 18', NULL ]);
|
|
|
|
gtk_text_buffer_create_tag (source_buffer, 'comment', 'foreground', ['red', NULL]);
|
|
|
|
gtk_text_buffer_create_tag (source_buffer, 'type', 'foreground', ['ForestGreen', NULL]);
|
|
|
|
gtk_text_buffer_create_tag (source_buffer, 'string', 'foreground',
|
|
['RosyBrown', 'weight', PANGO_WEIGHT_BOLD, NULL]);
|
|
|
|
gtk_text_buffer_create_tag (source_buffer, 'control', 'foreground', ['purple', NULL]);
|
|
|
|
gtk_text_buffer_create_tag (source_buffer, 'preprocessor', 'style',
|
|
[ PANGO_STYLE_OBLIQUE, 'foreground', 'blue', NULL] );
|
|
|
|
gtk_text_buffer_create_tag (source_buffer, 'function', 'weight',
|
|
[ PANGO_WEIGHT_BOLD, 'foreground', 'DarkGoldenrod4', NULL]);
|
|
|
|
gtk_window_set_default_size (GTK_WINDOW (window), 600, 400);
|
|
gtk_widget_show_all (window);
|
|
|
|
gtk_main;
|
|
end.
|