Add syntax support for Ada

Add submodule with sublime syntax.

Add corresponding tests for both Ada (in adb/ads) and for the companion tool
gpr.

fixes #1300

Signed-off-by: Marc Poulhiès <dkm@kataplop.net>

tests/syntax-tests/highlighted/Ada/click.adb

@@ -0,0 +1,308 @@
+with Chests.Ring_Buffers;
+with USB.Device.HID.Keyboard;
+
+package body Click is
+   ----------------
+   --  DEBOUNCE  --
+   ----------------
+
+   --  Ideally, in a separate package.
+
+   --  should be [], but not fixed yet in GCC 11.
+   Current_Status : Key_Matrix := [others => [others => False]];
+   New_Status : Key_Matrix := [others => [others => False]];
+   Since : Natural := 0;
+   --   Nb_Bounce : Natural := 5;
+
+   function Update (NewS : Key_Matrix) return Boolean is
+   begin
+      --  The new state is the same as the current stable state => Do nothing.
+      if Current_Status = NewS then
+         Since := 0;
+         return False;
+      end if;
+
+      if New_Status /= NewS then
+         --  The new state differs from the previous
+         --  new state (bouncing) => reset
+         New_Status := NewS;
+         Since := 1;
+      else
+         --  The new state hasn't changed since last
+         --  update => towards stabilization.
+         Since := Since + 1;
+      end if;
+
+      if Since > Nb_Bounce then
+         declare
+            Tmp : constant Key_Matrix := Current_Status;
+         begin
+            --  New state has been stable enough.
+            --  Latch it and notifies caller.
+            Current_Status := New_Status;
+            New_Status := Tmp;
+            Since := 0;
+         end;
+
+         return True;
+      else
+         --  Not there yet
+         return False;
+      end if;
+   end Update;
+
+   procedure Get_Matrix;
+   --  Could use := []; but GNAT 12 has a bug (fixed in upcoming 13)
+   Read_Status : Key_Matrix := [others => [others => False]];
+
+   function Get_Events return Events is
+      Num_Evt : Natural := 0;
+      New_S : Key_Matrix renames Read_Status;
+   begin
+      Get_Matrix;
+      if Update (New_S) then
+         for I in Current_Status'Range (1) loop
+            for J in Current_Status'Range (2) loop
+               if (not New_Status (I, J) and then Current_Status (I, J))
+                 or else (New_Status (I, J) and then not Current_Status (I, J))
+               then
+                  Num_Evt := Num_Evt + 1;
+               end if;
+            end loop;
+         end loop;
+
+         declare
+            Evts : Events (Natural range 1 .. Num_Evt);
+            Cursor : Natural range 1 .. Num_Evt + 1 := 1;
+         begin
+            for I in Current_Status'Range (1) loop
+               for J in Current_Status'Range (2) loop
+                  if not New_Status (I, J)
+                    and then Current_Status (I, J)
+                  then
+                     --  Pressing I, J
+                     Evts (Cursor) := [
+                                       Evt => Press,
+                                       Col => I,
+                                       Row => J
+                                      ];
+                     Cursor := Cursor + 1;
+                  elsif New_Status (I, J)
+                    and then not Current_Status (I, J)
+                  then
+                     --  Release I, J
+                     Evts (Cursor) := [
+                                       Evt => Release,
+                                       Col => I,
+                                       Row => J
+                                      ];
+                     Cursor := Cursor + 1;
+                  end if;
+               end loop;
+            end loop;
+            return Evts;
+         end;
+      end if;
+
+      return [];
+   end Get_Events;
+
+   procedure Get_Matrix  is -- return Key_Matrix is
+   begin
+      for Row in Keys.Rows'Range loop
+         Keys.Rows (Row).Clear;
+
+         for Col in Keys.Cols'Range loop
+            Read_Status (Col, Row) := not Keys.Cols (Col).Set;
+         end loop;
+         Keys.Rows (Row).Set;
+      end loop;
+   end Get_Matrix;
+
+   --  End of DEBOUNCE
+
+   --------------
+   --  Layout  --
+   --------------
+
+   package Events_Ring_Buffers is new Chests.Ring_Buffers
+     (Element_Type => Event,
+      Capacity     => 16);
+
+   Queued_Events : Events_Ring_Buffers.Ring_Buffer;
+
+   type Statet is (Normal_Key, Layer_Mod, None);
+   type State is record
+      Typ : Statet;
+      Code : Key_Code_T;
+      Layer_Value : Natural;
+      --  Col : ColR;
+      --  Row : RowR;
+   end record;
+
+   type State_Array is array (ColR, RowR) of State;
+   States : State_Array := [others => [others => (Typ => None, Code => No, Layer_Value => 0)]];
+
+   function Kw (Code : Key_Code_T) return Action is
+   begin
+      return (T => Key, C => Code, L => 0);
+   end Kw;
+
+   function Lw (V : Natural) return Action is
+   begin
+      return (T => Layer, C => No, L => V);
+   end Lw;
+
+   --  FIXME: hardcoded max number of events
+   subtype Events_Range is Natural range 0 .. 60;
+   type Array_Of_Reg_Events is array (Events_Range) of Event;
+
+   Stamp : Natural := 0;
+
+   procedure Register_Events (L : Layout; Es : Events) is
+   begin
+      Stamp := Stamp + 1;
+
+      Log ("Reg events: " & Stamp'Image);
+      Log (Es'Length'Image);
+      for E of Es loop
+         declare
+         begin
+            if Events_Ring_Buffers.Is_Full (Queued_Events) then
+               raise Program_Error;
+            end if;
+
+            Events_Ring_Buffers.Append (Queued_Events, E);
+         end;
+         --         Log ("Reg'ed events:" &  Events_Mark'Image);
+         Log ("Reg'ed events:" &  Events_Ring_Buffers.Length (Queued_Events)'Image);
+      end loop;
+   end Register_Events;
+
+   procedure Release (Col: Colr; Row: Rowr) is
+   begin
+      if States (Col, Row).Typ = None then
+         raise Program_Error;
+      end if;
+      States (Col, Row) := (Typ => None, Code => No, Layer_Value => 0);
+   end Release;
+
+   function Get_Current_Layer return Natural is
+      L : Natural := 0;
+   begin
+      for S of States loop
+         if S.Typ = Layer_Mod then
+            L := L + S.Layer_Value;
+         end if;
+      end loop;
+
+      return L;
+   end Get_Current_Layer;
+
+   --  Tick the event.
+   --  Returns TRUE if it needs to stay in the queued events
+   --  FALSE if the event has been consumed.
+
+   function Tick (L: Layout; E : in out Event) return Boolean is
+      Current_Layer : Natural := Get_Current_Layer;
+      A : Action renames L (Current_Layer, E.Row, E.Col);
+   begin
+      case E.Evt is
+         when Press =>
+            case A.T is
+               when Key =>
+                  States (E.Col, E.Row) :=
+                    (Typ => Normal_Key,
+                     Code => A.C,
+                     Layer_Value => 0);
+               when Layer =>
+                  States (E.Col, E.Row) := (Typ => Layer_Mod, Layer_Value => A.L, Code => No);
+               when others =>
+                  raise Program_Error;
+            end case;
+
+         when Release =>
+            Release (E.Col, E.Row);
+      end case;
+      return False;
+   end Tick;
+
+   Last_Was_Empty_Log : Boolean := False;
+
+   procedure Tick (L : Layout) is
+   begin
+      for I in 1 .. Events_Ring_Buffers.Length(Queued_Events) loop
+         declare
+            E : Event := Events_Ring_Buffers.Last_Element (Queued_Events);
+         begin
+            Events_Ring_Buffers.Delete_Last (Queued_Events);
+            if Tick (L, E) then
+               Events_Ring_Buffers.Prepend (Queued_Events, E);
+            end if;
+         end;
+      end loop;
+      if not Last_Was_Empty_Log or else Events_Ring_Buffers.Length(Queued_Events) /= 0 then
+         Log ("End Tick layout, events: " & Events_Ring_Buffers.Length(Queued_Events)'Image);
+         Last_Was_Empty_Log := Events_Ring_Buffers.Length(Queued_Events) = 0;
+      end if;
+   end Tick;
+
+   function Get_Key_Codes return Key_Codes_T is
+      Codes : Key_Codes_T (0 .. 10);
+      Wm: Natural := 0;
+   begin
+      for S of States loop
+         if S.Typ = Normal_Key and then
+            (S.Code < LCtrl or else S.Code > RGui)
+         then
+            Codes (Wm) := S.Code;
+            Wm := Wm + 1;
+         end if;
+      end loop;
+
+      if Wm = 0 then
+         return [];
+      else
+         return Codes (0 .. Wm - 1);
+      end if;
+   end Get_Key_Codes;
+
+   function Get_Modifiers return Key_Modifiers is
+      use USB.Device.HID.Keyboard;
+      KM : Key_Modifiers (1..8);
+      I : Natural := 0;
+   begin
+      for S of States loop
+         if S.Typ = Normal_Key then
+            I := I + 1;
+            case S.Code is
+              when LCtrl =>
+                 KM(I) := Ctrl_Left;
+              when RCtrl =>
+                 KM(I) := Ctrl_Right;
+              when LShift =>
+                 KM(I) := Shift_Left;
+              when RShift =>
+                 KM(I) := Shift_Right;
+              when LAlt =>
+                 KM(I) := Alt_Left;
+              when RAlt =>
+                 KM(I) := Alt_Right;
+              when LGui =>
+                 KM(I) := Meta_Left;
+              when RGui =>
+                 KM(I) := Meta_Right;
+              when others =>
+                 I := I - 1;
+            end case;
+         end if;
+      end loop;
+      return KM (1..I);
+   end Get_Modifiers;
+
+   procedure Init is
+   begin
+      Events_Ring_Buffers.Clear (Queued_Events);
+   end Init;
+
+end Click;

tests/syntax-tests/highlighted/Ada/click.ads

@@ -0,0 +1,339 @@
+with HAL.GPIO;
+with USB.Device.HID.Keyboard;
+
+generic
+   Nb_Bounce : Natural;
+   type ColR is (<>);
+   type RowR is (<>);
+
+   type GPIOP is new HAL.GPIO.GPIO_Point with private;
+
+   type Cols_T is array (ColR) of GPIOP;
+   type Rows_T is array (RowR) of GPIOP;
+
+   Cols : Cols_T;
+   Rows : Rows_T;
+   Num_Layers : Natural;
+
+   with procedure Log (S : String; L :  Integer := 1; Deindent : Integer := 0);
+package Click is
+
+   type Keys_T is record
+      Cols : Cols_T;
+      Rows : Rows_T;
+   end record;
+
+   Keys : Keys_T :=
+     (Rows => Rows, Cols => Cols);
+
+   type Key_Matrix is array (ColR, RowR) of Boolean;
+
+   --------------------------
+   --  Events & Debouncing --
+   --------------------------
+
+   MaxEvents : constant Positive := 20;
+
+   type EventT is (Press, Release);
+   type Event is record
+      Evt : EventT;
+      Col : ColR;
+      Row : RowR;
+   end record;
+
+   type Events is array (Natural range <>) of Event;
+
+   function Get_Events return Events;
+   function Update (NewS : Key_Matrix) return Boolean;
+
+   -------------
+   --  Layout --
+   -------------
+   ---------------
+   --  Keycodes --
+   ---------------
+
+   --  Keycodes copy/pasted from the excelent Keyberon Rust firmware:
+   --  https://github.com/TeXitoi/keyberon/
+
+   type Key_Code_T is
+     (
+      --   The "no" key, a placeholder to express nothing.
+      No, --  = 0x00,
+          --  / Error if too much keys are pressed at
+          --  the same time.
+      ErrorRollOver,
+      --  / The POST fail error.
+      PostFail,
+      --  / An undefined error occured.
+      ErrorUndefined,
+      --  / `a` and `A`.
+      A,
+      B,
+      C,
+      D,
+      E,
+      F,
+      G,
+      H,
+      I,
+      J,
+      K,
+      L,
+      M, --  0x10
+      N,
+      O,
+      P,
+      Q,
+      R,
+      S,
+      T,
+      U,
+      V,
+      W,
+      X,
+      Y,
+      Z,
+      --   `1` and `!`.
+      Kb1,
+      --   `2` and `@`.
+      Kb2,
+      --   `3` and `#`.
+      Kb3, --  0x20
+      --  / `4` and `$`.
+      Kb4,
+      --   `5` and `%`.
+      Kb5,
+      --   `6` and `^`.
+      Kb6,
+      --   `7` and `&`.
+      Kb7,
+      --   `8` and `*`.
+      Kb8,
+      --   `9` and `(`.
+      Kb9,
+      --   `0` and `)`.
+      Kb0,
+      Enter,
+      Escape,
+      BSpace,
+      Tab,
+      Space,
+      --   `-` and `_`.
+      Minus,
+      --   `=` and `+`.
+      Equal,
+      --   `[` and `{`.
+      LBracket,
+      --   `]` and `}`.
+      RBracket, --  0x30
+      --  / `\` and `|`.
+      Bslash,
+      --   Non-US `#` and `~` (Typically near the Enter key).
+      NonUsHash,
+      --   `;` and `:`.
+      SColon,
+      --   `'` and `"`.
+      Quote,
+      --  How to have ` as code?
+      --   \` and `~`.
+      Grave,
+      --   `,` and `<`.
+      Comma,
+      --   `.` and `>`.
+      Dot,
+      --   `/` and `?`.
+      Slash,
+      CapsLock,
+      F1,
+      F2,
+      F3,
+      F4,
+      F5,
+      F6,
+      F7, --  0x40
+      F8,
+      F9,
+      F10,
+      F11,
+      F12,
+      PScreen,
+      ScrollLock,
+      Pause,
+      Insert,
+      Home,
+      PgUp,
+      Delete,
+      Endd,
+      PgDown,
+      Right,
+      Left, --  0x50
+      Down,
+      Up,
+      NumLock,
+      --   Keypad `/`
+      KpSlash,
+      --   Keypad `*`
+      KpAsterisk,
+      --   Keypad `-`.
+      KpMinus,
+      --   Keypad `+`.
+      KpPlus,
+      --   Keypad enter.
+      KpEnter,
+      --   Keypad 1.
+      Kp1,
+      Kp2,
+      Kp3,
+      Kp4,
+      Kp5,
+      Kp6,
+      Kp7,
+      Kp8, --  0x60
+      Kp9,
+      Kp0,
+      KpDot,
+      --   Non-US `\` and `|` (Typically near the Left-Shift key)
+      NonUsBslash,
+      Application, --  0x65
+      --  / not a key, used for errors
+      Power,
+      --   Keypad `=`.
+      KpEqual,
+      F13,
+      F14,
+      F15,
+      F16,
+      F17,
+      F18,
+      F19,
+      F20,
+      F21, --  0x70
+      F22,
+      F23,
+      F24,
+      Execute,
+      Help,
+      Menu,
+      Selectt,
+      Stop,
+      Again,
+      Undo,
+      Cut,
+      Copy,
+      Paste,
+      Find,
+      Mute,
+      VolUp, --  0x80
+      VolDown,
+      --   Deprecated.
+      LockingCapsLock,
+      --   Deprecated.
+      LockingNumLock,
+      --   Deprecated.
+      LockingScrollLock,
+      --  / Keypad `,`, also used for the
+      --  brazilian keypad period (.) key.
+      KpComma,
+      --   Used on AS/400 keyboard
+      KpEqualSign,
+      Intl1,
+      Intl2,
+      Intl3,
+      Intl4,
+      Intl5,
+      Intl6,
+      Intl7,
+      Intl8,
+      Intl9,
+      Lang1, --  0x90
+      Lang2,
+      Lang3,
+      Lang4,
+      Lang5,
+      Lang6,
+      Lang7,
+      Lang8,
+      Lang9,
+      AltErase,
+      SysReq,
+      Cancel,
+      Clear,
+      Prior,
+      Returnn,
+      Separator,
+      Outt, --  0xA0
+      Oper,
+      ClearAgain,
+      CrSel,
+      ExSel,
+
+      --  According to QMK, 0xA5-0xDF are not
+      --  usable on modern keyboards
+
+      --  Modifiers
+      --   Left Control.
+      LCtrl, --  = 0xE0,
+      --  / Left Shift.
+      LShift,
+      --   Left Alt.
+      LAlt,
+      --   Left GUI (the Windows key).
+      LGui,
+      --   Right Control.
+      RCtrl,
+      --   Right Shift.
+      RShift,
+      --   Right Alt (or Alt Gr). 
+      RAlt,
+      --   Right GUI (the Windows key).
+      RGui, --  0xE7
+
+      --  Unofficial
+      MediaPlayPause, --   0xE8,
+      MediaStopCD,
+      MediaPreviousSong,
+      MediaNextSong,
+      MediaEjectCD,
+      MediaVolUp,
+      MediaVolDown,
+      MediaMute,
+      MediaWWW, --  0xF0
+      MediaBack,
+      MediaForward,
+      MediaStop,
+      MediaFind,
+      MediaScrollUp,
+      MediaScrollDown,
+      MediaEdit,
+      MediaSleep,
+      MediaCoffee,
+      MediaRefresh,
+      MediaCalc --  0xFB
+     );
+
+   type Action_Type is (Key, No_Op, Trans, Layer, Multiple_Actions);
+
+   --   Should be a discriminated type
+   type Action is record
+      T : Action_Type; --  hould be the discriminant
+      C : Key_Code_T;
+      L : Natural;
+   end record;
+
+   function Kw (Code : Key_Code_T) return Action;
+   function Lw (V : Natural) return Action;
+
+   type Key_Modifiers is array (Natural range <>) of USB.Device.HID.Keyboard.Modifiers;
+
+   type Key_Codes_T is array (Natural range <>) of Key_Code_T;
+
+   subtype Ac is Action;
+   type Layout is array (0 .. Num_Layers - 1, RowR, ColR) of Action;
+   procedure Register_Events (L : Layout; Es : Events);
+   procedure Tick (L : Layout);
+
+   function Get_Key_Codes return Key_Codes_T;
+   function Get_Modifiers return Key_Modifiers;
+   procedure Init;
+end Click;

tests/syntax-tests/highlighted/Ada/click.gpr

@@ -0,0 +1,29 @@
+with "config/click_config.gpr";
+project Click is
+
+   for Library_Name use "Click";
+   for Library_Version use Project'Library_Name & ".so." & Click_Config.Crate_Version;
+
+   for Source_Dirs use ("src/", "config/");
+   for Object_Dir use "obj/" & Click_Config.Build_Profile;
+   for Create_Missing_Dirs use "True";
+   for Library_Dir use "lib";
+
+   type Library_Type_Type is ("relocatable", "static", "static-pic");
+   Library_Type : Library_Type_Type :=
+     external ("CLICK_LIBRARY_TYPE", external ("LIBRARY_TYPE", "static"));
+   for Library_Kind use Library_Type;
+
+   package Compiler is
+      for Default_Switches ("Ada") use Click_Config.Ada_Compiler_Switches & ("-gnatX", "-gnat2022");
+   end Compiler;
+
+   package Binder is
+      for Switches ("Ada") use ("-Es"); --  Symbolic traceback
+   end Binder;
+
+   package Install is
+      for Artifacts (".") use ("share");
+   end Install;
+
+end Click;