ncurses2-trace_set.adb

ncurses-5.4 需要的就来下把 一定会有用的哦

   function tracetrace (tlevel : Trace_Attribute_Set) return String is

      use BS;
      buf : Bounded_String := To_Bounded_String ("");
   begin
      --  The C version prints the hexadecimal value of the mask, we
      --  won't do that here because this is Ada.

      if tlevel = Trace_Disable then
         Append (buf, "Trace_Disable");
      else


         if subset (tlevel,
                    Trace_Attribute_Set'(Times => True, others => False)) then
            Append (buf, "Times");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Tputs => True, others => False)) then
            Append (buf, "Tputs");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Update => True, others => False)) then
            Append (buf, "Update");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Cursor_Move => True,
                                         others => False)) then
            Append (buf, "Cursor_Move");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Character_Output => True,
                                         others => False)) then
            Append (buf, "Character_Output");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Ordinary) then
            Append (buf, "Ordinary");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Calls => True, others => False)) then
            Append (buf, "Calls");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Virtual_Puts => True,
                                         others => False)) then
            Append (buf, "Virtual_Puts");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Input_Events => True,
                                         others => False)) then
            Append (buf, "Input_Events");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(TTY_State => True,
                                         others => False)) then
            Append (buf, "TTY_State");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Internal_Calls => True,
                                         others => False)) then
            Append (buf, "Internal_Calls");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Character_Calls => True,
                                         others => False)) then
            Append (buf, "Character_Calls");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Attribute_Set'(Termcap_TermInfo => True,
                                         others => False)) then
            Append (buf, "Termcap_TermInfo");
            Append (buf, ", ");
         end if;

         if subset (tlevel,
                    Trace_Maximum) then
            Append (buf, "Maximium");
            Append (buf, ", ");
         end if;
      end if;

      if To_String (buf) (Length (buf) - 1) = ',' then
         Delete (buf, Length (buf) - 1, Length (buf));
      end if;

      return To_String (buf);
   end tracetrace;

   function run_trace_menu (m : Menu) return Boolean is
      i, p : Item;
      changed : Boolean;
      c, v : Key_Code;
   begin
      loop
         changed := False;
         c := Getchar (Get_Window (m));
         v := menu_virtualize (c);
         case Driver (m, v) is
            when Unknown_Request =>
               return False;
            when others =>
               i := Current (m);
               if i = Menus.Items (m, 1) then -- the first item
                  for n in t_tbl'First + 1 .. t_tbl'Last loop
                     if Value (i) then
                        Set_Value (i, False);
                        changed := True;
                     end if;
                  end loop;
               else
                  for n in t_tbl'First + 1 .. t_tbl'Last loop
                     p := Menus.Items (m, n);
                     if Value (p) then
                        Set_Value (Menus.Items (m, 1), False);
                        changed := True;
                        exit;
                     end if;
                  end loop;
               end if;
               if not changed then
                  return True;
               end if;
         end case;
      end loop;
   end run_trace_menu;

   nc_tracing, mask : Trace_Attribute_Set;
   pragma Import (C, nc_tracing, "_nc_tracing");
   items_a : Item_Array_Access :=
     new Item_Array (t_tbl'First .. t_tbl'Last + 1);
   mrows : Line_Count;
   mcols : Column_Count;
   menuwin : Window;
   menu_y : constant Line_Position := 8;
   menu_x : constant Column_Position := 8;
   ip : Item;
   m : Menu;
   newtrace : Trace_Attribute_Set;
begin
   Add (Line => 0, Column => 0, Str => "Interactively set trace level:");
   Add (Line => 2, Column => 0,
        Str => "  Press space bar to toggle a selection.");
   Add (Line => 3, Column => 0,
        Str => "  Use up and down arrow to move the select bar.");
   Add (Line => 4, Column => 0,
        Str => "  Press return to set the trace level.");
   Add (Line => 6, Column => 0, Str => "(Current trace level is ");
   Add (Str => tracetrace (nc_tracing) & " numerically: " &
        trace_num (nc_tracing));
   Add (Ch => ')');

   Refresh;

   for n in t_tbl'Range loop
      items_a (n) := New_Item (t_tbl (n).name.all);
   end loop;
   items_a (t_tbl'Last + 1) := Null_Item;

   m := New_Menu (items_a);

   Set_Format (m, 16, 2);
   Scale (m, mrows, mcols);

   Switch_Options (m, (One_Valued => True, others => False), On => False);
   menuwin := New_Window (mrows + 2, mcols + 2, menu_y, menu_x);
   Set_Window (m, menuwin);
   Set_KeyPad_Mode (menuwin, SwitchOn => True);
   Box (menuwin);

   Set_Sub_Window (m, Derived_Window (menuwin, mrows, mcols, 1, 1));

   Post (m);

   for n in t_tbl'Range loop
      ip := Items (m, n);
      mask := t_tbl (n).mask;
      if mask = Trace_Disable then
         Set_Value (ip, nc_tracing = Trace_Disable);
      elsif subset (sub => mask, super => nc_tracing) then
         Set_Value (ip, True);
      end if;
   end loop;

   while run_trace_menu (m) loop
      null;
   end loop;

   newtrace := Trace_Disable;
   for n in t_tbl'Range loop
      ip := Items (m, n);
      if Value (ip) then
         mask := t_tbl (n).mask;
         newtrace := trace_or (newtrace, mask);
      end if;
   end loop;

   Trace_On (newtrace);
   Trace_Put ("trace level interactively set to " &
              tracetrace (nc_tracing));

   Move_Cursor (Line => Lines - 4, Column => 0);
   Add (Str => "Trace level is ");
   Add (Str => tracetrace (nc_tracing));
   Add (Ch => newl);
   Pause; -- was just Add(); Getchar

   Post (m, False);
   --  menuwin has subwindows I think, which makes an error.
   declare begin
      Delete (menuwin);
   exception when Curses_Exception => null; end;

   --  free_menu(m);
   --  free_item()
end ncurses2.trace_set;