X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fncurses2-trace_set.adb;h=1e2716e1e25cad02d6e524c5c8ab48afd428129b;hp=10b605a7b2f073ca68ff4af158ab56e49c6c04f5;hb=36b653e854865c31c56f04d059d78a0d5e3f4e24;hpb=46722468f47c2b77b3987729b4bcf2321cccfd01 diff --git a/Ada95/samples/ncurses2-trace_set.adb b/Ada95/samples/ncurses2-trace_set.adb index 10b605a7..1e2716e1 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-2006,2008 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.3 $ +-- $Date: 2008/07/26 18:46:18 $ -- Binding Version 01.00 ------------------------------------------------------------------------------ with ncurses2.util; use ncurses2.util; @@ -54,7 +55,7 @@ procedure ncurses2.trace_set is 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 begin @@ -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:"); @@ -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;