X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fncurses2-trace_set.adb;h=7537afe407ee5c19820710a4b9c762d6b3fc3549;hp=10b605a7b2f073ca68ff4af158ab56e49c6c04f5;hb=d1a026123ac051716cdc16278345c1fb5c843b79;hpb=46722468f47c2b77b3987729b4bcf2321cccfd01 diff --git a/Ada95/samples/ncurses2-trace_set.adb b/Ada95/samples/ncurses2-trace_set.adb index 10b605a7..7537afe4 100644 --- a/Ada95/samples/ncurses2-trace_set.adb +++ b/Ada95/samples/ncurses2-trace_set.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 2000 Free Software Foundation, Inc. -- +-- Copyright (c) 2000-2008,2011 Free Software Foundation, Inc. -- -- -- -- Permission is hereby granted, free of charge, to any person obtaining a -- -- copy of this software and associated documentation files (the -- @@ -35,7 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Eugene V. Melaragno 2000 -- Version Control --- $Revision: 1.1 $ +-- $Revision: 1.5 $ +-- $Date: 2011/03/23 00:40:33 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with ncurses2.util; use ncurses2.util; @@ -49,14 +50,14 @@ with Ada.Strings.Bounded; procedure ncurses2.trace_set is - function menu_virtualize (c : Key_Code) return Menu_Request_Code; + function menu_virtualize (c : Key_Code) return Key_Code; function subset (super, sub : Trace_Attribute_Set) return Boolean; function trace_or (a, b : Trace_Attribute_Set) return Trace_Attribute_Set; function trace_num (tlevel : Trace_Attribute_Set) return String; function tracetrace (tlevel : Trace_Attribute_Set) return String; - function run_trace_menu (m : Menu) return Boolean; + function run_trace_menu (m : Menu; count : Integer) return Boolean; - function menu_virtualize (c : Key_Code) return Menu_Request_Code is + function menu_virtualize (c : Key_Code) return Key_Code is begin case c is when Character'Pos (newl) | Key_Exit => @@ -83,7 +84,6 @@ procedure ncurses2.trace_set is end case; end menu_virtualize; - type string_a is access String; type tbl_entry is record name : string_a; @@ -126,7 +126,6 @@ procedure ncurses2.trace_set is package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (300); - function subset (super, sub : Trace_Attribute_Set) return Boolean is begin if @@ -238,7 +237,6 @@ procedure ncurses2.trace_set is return result'Img; end trace_num; - function tracetrace (tlevel : Trace_Attribute_Set) return String is use BS; @@ -251,7 +249,6 @@ procedure ncurses2.trace_set is Append (buf, "Trace_Disable"); else - if subset (tlevel, Trace_Attribute_Set'(Times => True, others => False)) then Append (buf, "Times"); @@ -352,13 +349,13 @@ procedure ncurses2.trace_set is return To_String (buf); end tracetrace; - function run_trace_menu (m : Menu) return Boolean is + function run_trace_menu (m : Menu; count : Integer) return Boolean is i, p : Item; changed : Boolean; c, v : Key_Code; begin loop - changed := False; + changed := (count /= 0); c := Getchar (Get_Window (m)); v := menu_virtualize (c); case Driver (m, v) is @@ -392,7 +389,7 @@ procedure ncurses2.trace_set is nc_tracing, mask : Trace_Attribute_Set; pragma Import (C, nc_tracing, "_nc_tracing"); - items_a : Item_Array_Access := + items_a : constant Item_Array_Access := new Item_Array (t_tbl'First .. t_tbl'Last + 1); mrows : Line_Count; mcols : Column_Count; @@ -401,6 +398,7 @@ procedure ncurses2.trace_set is menu_x : constant Column_Position := 8; ip : Item; m : Menu; + count : Integer; newtrace : Trace_Attribute_Set; begin Add (Line => 0, Column => 0, Str => "Interactively set trace level:"); @@ -418,9 +416,9 @@ begin Refresh; for n in t_tbl'Range loop - items_a (n) := New_Item (t_tbl (n).name.all); + items_a.all (n) := New_Item (t_tbl (n).name.all); end loop; - items_a (t_tbl'Last + 1) := Null_Item; + items_a.all (t_tbl'Last + 1) := Null_Item; m := New_Menu (items_a); @@ -447,8 +445,9 @@ begin end if; end loop; - while run_trace_menu (m) loop - null; + count := 1; + while run_trace_menu (m, count) loop + count := count + 1; end loop; newtrace := Trace_Disable;