(* 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.