X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fncurses2-trace_set.adb;h=df4468b23812bf65fb76673cc466642e32f46bc5;hp=10b605a7b2f073ca68ff4af158ab56e49c6c04f5;hb=b9a2bd87a73d976d1c916815e2d370bf1090d1b2;hpb=46722468f47c2b77b3987729b4bcf2321cccfd01 diff --git a/Ada95/samples/ncurses2-trace_set.adb b/Ada95/samples/ncurses2-trace_set.adb index 10b605a7..df4468b2 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-2011,2014 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.6 $ +-- $Date: 2014/09/13 19:10:18 $ -- 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 @@ -142,7 +141,8 @@ procedure ncurses2.trace_set is (super.Internal_Calls or not sub.Internal_Calls) and (super.Character_Calls or not sub.Character_Calls) and (super.Termcap_TermInfo or not sub.Termcap_TermInfo) and - True then + True + then return True; else return False; @@ -238,7 +238,6 @@ procedure ncurses2.trace_set is return result'Img; end trace_num; - function tracetrace (tlevel : Trace_Attribute_Set) return String is use BS; @@ -251,95 +250,108 @@ procedure ncurses2.trace_set is Append (buf, "Trace_Disable"); else - if subset (tlevel, - Trace_Attribute_Set'(Times => True, others => False)) then + 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 + 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 + 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 + others => False)) + then Append (buf, "Cursor_Move"); Append (buf, ", "); end if; if subset (tlevel, Trace_Attribute_Set'(Character_Output => True, - others => False)) then + others => False)) + then Append (buf, "Character_Output"); Append (buf, ", "); end if; if subset (tlevel, - Trace_Ordinary) then + Trace_Ordinary) + then Append (buf, "Ordinary"); Append (buf, ", "); end if; if subset (tlevel, - Trace_Attribute_Set'(Calls => True, others => False)) then + 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 + others => False)) + then Append (buf, "Virtual_Puts"); Append (buf, ", "); end if; if subset (tlevel, Trace_Attribute_Set'(Input_Events => True, - others => False)) then + others => False)) + then Append (buf, "Input_Events"); Append (buf, ", "); end if; if subset (tlevel, Trace_Attribute_Set'(TTY_State => True, - others => False)) then + others => False)) + then Append (buf, "TTY_State"); Append (buf, ", "); end if; if subset (tlevel, Trace_Attribute_Set'(Internal_Calls => True, - others => False)) then + others => False)) + then Append (buf, "Internal_Calls"); Append (buf, ", "); end if; if subset (tlevel, Trace_Attribute_Set'(Character_Calls => True, - others => False)) then + others => False)) + then Append (buf, "Character_Calls"); Append (buf, ", "); end if; if subset (tlevel, Trace_Attribute_Set'(Termcap_TermInfo => True, - others => False)) then + others => False)) + then Append (buf, "Termcap_TermInfo"); Append (buf, ", "); end if; if subset (tlevel, - Trace_Maximum) then + Trace_Maximum) + then Append (buf, "Maximium"); Append (buf, ", "); end if; @@ -352,13 +364,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 +404,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 +413,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 +431,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 +460,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;