m2-GTK4/demos/DemosChooser.mod

IMPLEMENTATION MODULE DemosChooser ;

(*
   See the GTK C originals in gtk/demos/gtk-demo:
     combobox.c         -> DoComboBox
     entry_completion.c -> DoEntryCompletion
     entry_undo.c       -> DoEntryUndo
     dialog.c           -> DoDialog

   The gtk-demo contract is: on the first call build the window and store
   it in a module-level variable; on later calls just toggle the window's
   visibility, destroying it (and clearing the variable) when it is
   already visible.  Return the window, or NIL once destroyed.

   None of the deprecated, model-based widgets these demos use are
   exposed under src/ (GtkComboBox, GtkComboBoxText, GtkTreeModel,
   GtkListStore, GtkTreeStore, GtkCellRenderer, GtkCellLayout), and
   neither are GtkDialog / GtkMessageDialog.  Each affected spot is
   adapted to a bound equivalent and marked SIMPLIFIED below:

     * combobox: the four combo boxes become GtkDropDown widgets over a
       GtkStringList (the documented modern replacement).  The icon
       renderer, the row separator, the insensitive rows and the
       GtkTreeStore hierarchy cannot be reproduced, so the "Items with
       icons" frame lists its five labels and the "Where are we ?" frame
       lists the capitals of its tree flattened.  The editable combo is
       a drop-down with search enabled; the "String IDs" property
       binding (g_object_bind_property, unbound) is emulated by wiring
       the drop-down's "notify::selected" and the entry's "changed"
       signals together.
     * entry_completion: GtkEntryCompletion is bound, but the
       GtkTreeModel/GtkListStore it needs for its items is not, so the
       completion is created with a text column but no model.  The
       inline-completion and inline-selection setters are not bound
       either.
     * entry_undo: gtk_editable_set_enable_undo() is not bound, so the
       entry is created without enabling undo/redo.
     * dialog: GtkDialog/GtkMessageDialog are replaced by
       AdwMessageDialog (responses plus an extra child); plain labels
       stand in for the mnemonic labels, whose setters
       (gtk_label_new_with_mnemonic / gtk_label_set_mnemonic_widget) are
       not bound.
*)

FROM SYSTEM IMPORT ADDRESS, ADR;
FROM GtkWindow IMPORT gtk_window_new, gtk_window_set_title,
   gtk_window_set_resizable, gtk_window_set_child, gtk_window_destroy,
   gtk_window_present;
FROM GtkWidget IMPORT gtk_widget_set_visible, gtk_widget_get_visible,
   gtk_widget_set_margin_start, gtk_widget_set_margin_end,
   gtk_widget_set_margin_top, gtk_widget_set_margin_bottom,
   gtk_widget_set_hexpand, gtk_widget_set_vexpand,
   gtk_widget_set_halign, gtk_widget_set_valign;
FROM GtkEnums IMPORT GtkVertical, GtkHorizontal, GtkAlignCenter;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
FROM GtkFrame IMPORT gtk_frame_new, gtk_frame_set_child;
FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_markup;
FROM GtkGrid IMPORT gtk_grid_new, gtk_grid_attach,
   gtk_grid_set_row_spacing, gtk_grid_set_column_spacing;
FROM GtkSeparator IMPORT gtk_separator_new;
FROM GtkButton IMPORT gtk_button_new_with_mnemonic;
FROM GtkEntry IMPORT gtk_entry_new, gtk_entry_set_completion;
FROM GtkEntryCompletion IMPORT gtk_entry_completion_new,
   gtk_entry_completion_set_text_column,
   gtk_entry_completion_set_popup_completion;
FROM GtkEditable IMPORT gtk_editable_get_text, gtk_editable_set_text;
FROM GtkDropDown IMPORT gtk_drop_down_new, gtk_drop_down_set_selected,
   gtk_drop_down_get_selected, gtk_drop_down_get_model,
   gtk_drop_down_set_enable_search;
FROM GtkStringList IMPORT gtk_string_list_new, gtk_string_list_append,
   gtk_string_list_get_string;
FROM AdwMessageDialog IMPORT adw_message_dialog_new,
   adw_message_dialog_add_response, adw_message_dialog_set_default_response,
   adw_message_dialog_set_extra_child;
FROM GtkClosures IMPORT Connect2, Connect3;
FROM GtkUtils IMPORT IntToStr, CStrToM2, StrAppend;
FROM GLib IMPORT g_strcmp0;

(* ================================================================== *)
(* combobox                                                           *)
(* ================================================================== *)

VAR
   comboWindow: ADDRESS;
   comboStringEntry: ADDRESS;      (* entry of the "String IDs" frame *)
   comboIdsDropDown: ADDRESS;      (* drop-down of the "String IDs" frame *)

(* Keep the two sides of the (unbound) active-id <-> text property
   binding in sync: selecting a drop-down item writes the entry, and
   typing an exact item writes the drop-down. *)
PROCEDURE OnComboSelected (dropdown: ADDRESS; pspec: ADDRESS; data: ADDRESS);
VAR
   model, item: ADDRESS;
   buf: ARRAY [0..63] OF CHAR;
BEGIN
   model := gtk_drop_down_get_model(dropdown);
   item := gtk_string_list_get_string(model, gtk_drop_down_get_selected(dropdown));
   CStrToM2(item, buf);
   gtk_editable_set_text(comboStringEntry, buf)
END OnComboSelected;

PROCEDURE OnComboEntryChanged (entry: ADDRESS; data: ADDRESS);
VAR
   model, item: ADDRESS;
   text, buf: ARRAY [0..63] OF CHAR;
   i: INTEGER;
BEGIN
   CStrToM2(gtk_editable_get_text(entry), text);
   model := gtk_drop_down_get_model(comboIdsDropDown);
   FOR i := 0 TO 2 DO
      item := gtk_string_list_get_string(model, VAL(CARDINAL, i));
      CStrToM2(item, buf);
      IF g_strcmp0(ADR(text), ADR(buf)) = 0 THEN
         gtk_drop_down_set_selected(comboIdsDropDown, VAL(CARDINAL, i));
         RETURN
      END
   END
END OnComboEntryChanged;

(* The capitals of create_capital_store(), flattened (the group rows and
   the tree shape are lost with GtkTreeStore unbound).  Index 8 is
   Boston, which is what the C demo selects via path (0, 8). *)
PROCEDURE AddCapitals (list: ADDRESS);
BEGIN
   gtk_string_list_append(list, "Albany");
   gtk_string_list_append(list, "Annapolis");
   gtk_string_list_append(list, "Atlanta");
   gtk_string_list_append(list, "Augusta");
   gtk_string_list_append(list, "Austin");
   gtk_string_list_append(list, "Baton Rouge");
   gtk_string_list_append(list, "Bismarck");
   gtk_string_list_append(list, "Boise");
   gtk_string_list_append(list, "Boston");
   gtk_string_list_append(list, "Carson City");
   gtk_string_list_append(list, "Charleston");
   gtk_string_list_append(list, "Cheyenne");
   gtk_string_list_append(list, "Columbia");
   gtk_string_list_append(list, "Columbus");
   gtk_string_list_append(list, "Concord");
   gtk_string_list_append(list, "Denver");
   gtk_string_list_append(list, "Des Moines");
   gtk_string_list_append(list, "Dover");
   gtk_string_list_append(list, "Frankfort");
   gtk_string_list_append(list, "Harrisburg");
   gtk_string_list_append(list, "Hartford");
   gtk_string_list_append(list, "Helena");
   gtk_string_list_append(list, "Honolulu");
   gtk_string_list_append(list, "Indianapolis");
   gtk_string_list_append(list, "Jackson");
   gtk_string_list_append(list, "Jefferson City");
   gtk_string_list_append(list, "Juneau");
   gtk_string_list_append(list, "Lansing");
   gtk_string_list_append(list, "Lincoln");
   gtk_string_list_append(list, "Little Rock");
   gtk_string_list_append(list, "Madison");
   gtk_string_list_append(list, "Montgomery");
   gtk_string_list_append(list, "Montpelier");
   gtk_string_list_append(list, "Nashville");
   gtk_string_list_append(list, "Oklahoma City");
   gtk_string_list_append(list, "Olympia");
   gtk_string_list_append(list, "Phoenix");
   gtk_string_list_append(list, "Pierre");
   gtk_string_list_append(list, "Providence");
   gtk_string_list_append(list, "Raleigh");
   gtk_string_list_append(list, "Richmond");
   gtk_string_list_append(list, "Sacramento");
   gtk_string_list_append(list, "Salem");
   gtk_string_list_append(list, "Salt Lake City");
   gtk_string_list_append(list, "Santa Fe");
   gtk_string_list_append(list, "Springfield");
   gtk_string_list_append(list, "St. Paul");
   gtk_string_list_append(list, "Tallahassee");
   gtk_string_list_append(list, "Topeka");
   gtk_string_list_append(list, "Trenton")
END AddCapitals;

PROCEDURE DoComboBox (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, frame, box, combo, list: ADDRESS;
BEGIN
   IF comboWindow = NIL THEN
      comboWindow := gtk_window_new();
      gtk_window_set_title(comboWindow, "Combo Boxes");

      vbox := gtk_box_new(GtkVertical, 2);
      gtk_widget_set_margin_start(vbox, 10);
      gtk_widget_set_margin_end(vbox, 10);
      gtk_widget_set_margin_top(vbox, 10);
      gtk_widget_set_margin_bottom(vbox, 10);
      gtk_window_set_child(comboWindow, vbox);

      (* Items with icons (icons, separator and insensitivity omitted) *)
      frame := gtk_frame_new("Items with icons");
      gtk_box_append(vbox, frame);
      box := gtk_box_new(GtkVertical, 0);
      gtk_widget_set_margin_start(box, 5);
      gtk_widget_set_margin_end(box, 5);
      gtk_widget_set_margin_top(box, 5);
      gtk_widget_set_margin_bottom(box, 5);
      gtk_frame_set_child(frame, box);

      list := gtk_string_list_new(NIL);
      gtk_string_list_append(list, "Warning");
      gtk_string_list_append(list, "Stop");
      gtk_string_list_append(list, "New");
      gtk_string_list_append(list, "Clear");
      gtk_string_list_append(list, "Open");
      combo := gtk_drop_down_new(list, NIL);
      gtk_drop_down_set_selected(combo, 0);
      gtk_box_append(box, combo);

      (* Where are we ? (tree flattened to its capitals) *)
      frame := gtk_frame_new("Where are we ?");
      gtk_box_append(vbox, frame);
      box := gtk_box_new(GtkVertical, 0);
      gtk_widget_set_margin_start(box, 5);
      gtk_widget_set_margin_end(box, 5);
      gtk_widget_set_margin_top(box, 5);
      gtk_widget_set_margin_bottom(box, 5);
      gtk_frame_set_child(frame, box);

      list := gtk_string_list_new(NIL);
      AddCapitals(list);
      combo := gtk_drop_down_new(list, NIL);
      gtk_drop_down_set_selected(combo, 8);
      gtk_box_append(box, combo);

      (* Editable (search stands in for the validating entry) *)
      frame := gtk_frame_new("Editable");
      gtk_box_append(vbox, frame);
      box := gtk_box_new(GtkVertical, 0);
      gtk_widget_set_margin_start(box, 5);
      gtk_widget_set_margin_end(box, 5);
      gtk_widget_set_margin_top(box, 5);
      gtk_widget_set_margin_bottom(box, 5);
      gtk_frame_set_child(frame, box);

      list := gtk_string_list_new(NIL);
      gtk_string_list_append(list, "One");
      gtk_string_list_append(list, "Two");
      gtk_string_list_append(list, "2\xC2\xBD");
      gtk_string_list_append(list, "Three");
      combo := gtk_drop_down_new(list, NIL);
      gtk_drop_down_set_enable_search(combo, 1);
      gtk_box_append(box, combo);

      (* String IDs (active-id binding emulated with two signals) *)
      frame := gtk_frame_new("String IDs");
      gtk_box_append(vbox, frame);
      box := gtk_box_new(GtkVertical, 0);
      gtk_widget_set_margin_start(box, 5);
      gtk_widget_set_margin_end(box, 5);
      gtk_widget_set_margin_top(box, 5);
      gtk_widget_set_margin_bottom(box, 5);
      gtk_frame_set_child(frame, box);

      list := gtk_string_list_new(NIL);
      gtk_string_list_append(list, "Not visible");
      gtk_string_list_append(list, "Visible when active");
      gtk_string_list_append(list, "Always visible");
      comboIdsDropDown := gtk_drop_down_new(list, NIL);
      gtk_box_append(box, comboIdsDropDown);

      comboStringEntry := gtk_entry_new();
      gtk_box_append(box, comboStringEntry);

      Connect3(comboIdsDropDown, "notify::selected", OnComboSelected, NIL);
      Connect2(comboStringEntry, "changed", OnComboEntryChanged, NIL)
   END;

   IF gtk_widget_get_visible(comboWindow) = 0 THEN
      gtk_widget_set_visible(comboWindow, 1)
   ELSE
      gtk_window_destroy(comboWindow);
      comboWindow := NIL;
      comboStringEntry := NIL;
      comboIdsDropDown := NIL
   END;
   RETURN comboWindow
END DoComboBox;

(* ================================================================== *)
(* entry_completion                                                   *)
(* ================================================================== *)

VAR
   entryCompletionWindow: ADDRESS;

PROCEDURE DoEntryCompletion (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, label, entry, completion: ADDRESS;
BEGIN
   IF entryCompletionWindow = NIL THEN
      entryCompletionWindow := gtk_window_new();
      gtk_window_set_title(entryCompletionWindow, "Completion");
      gtk_window_set_resizable(entryCompletionWindow, 0);

      vbox := gtk_box_new(GtkVertical, 12);
      gtk_widget_set_margin_start(vbox, 18);
      gtk_widget_set_margin_end(vbox, 18);
      gtk_widget_set_margin_top(vbox, 18);
      gtk_widget_set_margin_bottom(vbox, 18);
      gtk_window_set_child(entryCompletionWindow, vbox);

      label := gtk_label_new("");
      gtk_label_set_markup(label,
         "Try writing <b>total</b> or <b>gnome</b> for example.");
      gtk_box_append(vbox, label);

      entry := gtk_entry_new();
      gtk_box_append(vbox, entry);

      completion := gtk_entry_completion_new();
      gtk_entry_set_completion(entry, completion);

      (* SIMPLIFIED: GtkTreeModel/GtkListStore (the completion's model)
         are unbound, so there are no items to complete; only the text
         column and popup-completion setting survive.  The C demo's
         inline-completion/inline-selection setters are unbound too. *)
      gtk_entry_completion_set_text_column(completion, 0);
      gtk_entry_completion_set_popup_completion(completion, 1)
   END;

   IF gtk_widget_get_visible(entryCompletionWindow) = 0 THEN
      gtk_widget_set_visible(entryCompletionWindow, 1)
   ELSE
      gtk_window_destroy(entryCompletionWindow);
      entryCompletionWindow := NIL
   END;
   RETURN entryCompletionWindow
END DoEntryCompletion;

(* ================================================================== *)
(* entry_undo                                                         *)
(* ================================================================== *)

VAR
   entryUndoWindow: ADDRESS;

PROCEDURE DoEntryUndo (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, label, entry: ADDRESS;
BEGIN
   IF entryUndoWindow = NIL THEN
      entryUndoWindow := gtk_window_new();
      gtk_window_set_title(entryUndoWindow, "Undo and Redo");
      gtk_window_set_resizable(entryUndoWindow, 0);

      vbox := gtk_box_new(GtkVertical, 12);
      gtk_widget_set_margin_start(vbox, 18);
      gtk_widget_set_margin_end(vbox, 18);
      gtk_widget_set_margin_top(vbox, 18);
      gtk_widget_set_margin_bottom(vbox, 18);
      gtk_window_set_child(entryUndoWindow, vbox);

      label := gtk_label_new("");
      gtk_label_set_markup(label,
         "Use Control+z or Control+Shift+z to undo or redo changes");
      gtk_box_append(vbox, label);

      entry := gtk_entry_new();
      (* SIMPLIFIED: gtk_editable_set_enable_undo() is not bound, so
         undo/redo support cannot be turned on from here. *)
      gtk_box_append(vbox, entry)
   END;

   IF gtk_widget_get_visible(entryUndoWindow) = 0 THEN
      gtk_widget_set_visible(entryUndoWindow, 1)
   ELSE
      gtk_window_destroy(entryUndoWindow);
      entryUndoWindow := NIL
   END;
   RETURN entryUndoWindow
END DoEntryUndo;

(* ================================================================== *)
(* dialog                                                             *)
(* ================================================================== *)

VAR
   dialogWindow: ADDRESS;
   dialogEntry1, dialogEntry2: ADDRESS;          (* left-hand entries *)
   dialogLocalEntry1, dialogLocalEntry2: ADDRESS;
   dialogCount: INTEGER;

(* void message_dialog_clicked(GtkButton *button, gpointer user_data) *)
PROCEDURE OnMessageDialog (button: ADDRESS; data: ADDRESS);
VAR
   dialog: ADDRESS;
   body, num: ARRAY [0..63] OF CHAR;
BEGIN
   INC(dialogCount);

   body := "Has been shown ";
   IntToStr(dialogCount, num);
   StrAppend(body, num);
   StrAppend(body, " times");

   dialog := adw_message_dialog_new(dialogWindow, "Test message", body);
   adw_message_dialog_add_response(dialog, "ok", "_OK");
   adw_message_dialog_add_response(dialog, "cancel", "_Cancel");
   adw_message_dialog_set_default_response(dialog, "ok");
   gtk_window_present(dialog)
END OnMessageDialog;

(* void on_dialog_response(GtkDialog *dialog, int response, gpointer data) *)
PROCEDURE OnDialogResponse (dialog: ADDRESS; response: ADDRESS; data: ADDRESS);
VAR
   ok: ARRAY [0..3] OF CHAR;
   text: ARRAY [0..255] OF CHAR;
BEGIN
   ok := "ok";
   IF g_strcmp0(response, ADR(ok)) = 0 THEN
      CStrToM2(gtk_editable_get_text(dialogLocalEntry1), text);
      gtk_editable_set_text(dialogEntry1, text);
      CStrToM2(gtk_editable_get_text(dialogLocalEntry2), text);
      gtk_editable_set_text(dialogEntry2, text)
   END
   (* AdwMessageDialog closes itself once a response is activated. *)
END OnDialogResponse;

(* void interactive_dialog_clicked(GtkButton *button, gpointer user_data) *)
PROCEDURE OnInteractiveDialog (button: ADDRESS; data: ADDRESS);
VAR
   dialog, grid, label: ADDRESS;
   text: ARRAY [0..255] OF CHAR;
BEGIN
   dialog := adw_message_dialog_new(dialogWindow, "Interactive Dialog", "");
   adw_message_dialog_add_response(dialog, "ok", "_OK");
   adw_message_dialog_add_response(dialog, "cancel", "_Cancel");
   adw_message_dialog_set_default_response(dialog, "ok");

   grid := gtk_grid_new();
   gtk_widget_set_hexpand(grid, 1);
   gtk_widget_set_vexpand(grid, 1);
   gtk_widget_set_halign(grid, GtkAlignCenter);
   gtk_widget_set_valign(grid, GtkAlignCenter);
   gtk_grid_set_row_spacing(grid, 6);
   gtk_grid_set_column_spacing(grid, 6);

   (* SIMPLIFIED: plain labels, as the mnemonic variants are unbound. *)
   label := gtk_label_new("Entry 1");
   gtk_grid_attach(grid, label, 0, 0, 1, 1);
   dialogLocalEntry1 := gtk_entry_new();
   CStrToM2(gtk_editable_get_text(dialogEntry1), text);
   gtk_editable_set_text(dialogLocalEntry1, text);
   gtk_grid_attach(grid, dialogLocalEntry1, 1, 0, 1, 1);

   label := gtk_label_new("Entry 2");
   gtk_grid_attach(grid, label, 0, 1, 1, 1);
   dialogLocalEntry2 := gtk_entry_new();
   CStrToM2(gtk_editable_get_text(dialogEntry2), text);
   gtk_editable_set_text(dialogLocalEntry2, text);
   gtk_grid_attach(grid, dialogLocalEntry2, 1, 1, 1, 1);

   adw_message_dialog_set_extra_child(dialog, grid);

   Connect3(dialog, "response", OnDialogResponse, NIL);

   gtk_window_present(dialog)
END OnInteractiveDialog;

PROCEDURE DoDialog (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, vbox2, hbox, button, table, label: ADDRESS;
BEGIN
   IF dialogWindow = NIL THEN
      dialogWindow := gtk_window_new();
      gtk_window_set_title(dialogWindow, "Dialogs");
      gtk_window_set_resizable(dialogWindow, 0);

      vbox := gtk_box_new(GtkVertical, 8);
      gtk_widget_set_margin_start(vbox, 8);
      gtk_widget_set_margin_end(vbox, 8);
      gtk_widget_set_margin_top(vbox, 8);
      gtk_widget_set_margin_bottom(vbox, 8);
      gtk_window_set_child(dialogWindow, vbox);

      (* Standard message dialog *)
      hbox := gtk_box_new(GtkHorizontal, 8);
      gtk_box_append(vbox, hbox);
      button := gtk_button_new_with_mnemonic("_Message Dialog");
      Connect2(button, "clicked", OnMessageDialog, NIL);
      gtk_box_append(hbox, button);

      gtk_box_append(vbox, gtk_separator_new(GtkHorizontal));

      (* Interactive dialog *)
      hbox := gtk_box_new(GtkHorizontal, 8);
      gtk_box_append(vbox, hbox);
      vbox2 := gtk_box_new(GtkVertical, 0);

      button := gtk_button_new_with_mnemonic("_Interactive Dialog");
      Connect2(button, "clicked", OnInteractiveDialog, NIL);
      gtk_box_append(hbox, vbox2);
      gtk_box_append(vbox2, button);

      table := gtk_grid_new();
      gtk_grid_set_row_spacing(table, 4);
      gtk_grid_set_column_spacing(table, 4);
      gtk_box_append(hbox, table);

      label := gtk_label_new("Entry 1");
      gtk_grid_attach(table, label, 0, 0, 1, 1);

      dialogEntry1 := gtk_entry_new();
      gtk_grid_attach(table, dialogEntry1, 1, 0, 1, 1);

      label := gtk_label_new("Entry 2");
      gtk_grid_attach(table, label, 0, 1, 1, 1);

      dialogEntry2 := gtk_entry_new();
      gtk_grid_attach(table, dialogEntry2, 1, 1, 1, 1)
   END;

   IF gtk_widget_get_visible(dialogWindow) = 0 THEN
      gtk_widget_set_visible(dialogWindow, 1)
   ELSE
      gtk_window_destroy(dialogWindow);
      dialogWindow := NIL;
      dialogEntry1 := NIL;
      dialogEntry2 := NIL;
      dialogLocalEntry1 := NIL;
      dialogLocalEntry2 := NIL
   END;
   RETURN dialogWindow
END DoDialog;

BEGIN
   comboWindow := NIL;
   comboStringEntry := NIL;
   comboIdsDropDown := NIL;
   entryCompletionWindow := NIL;
   entryUndoWindow := NIL;
   dialogWindow := NIL;
   dialogEntry1 := NIL;
   dialogEntry2 := NIL;
   dialogLocalEntry1 := NIL;
   dialogLocalEntry2 := NIL;
   dialogCount := 0
END DemosChooser.