1--
2--  Copyright (c) 2014-15 John Marino <draco@marino.st>
3--
4--  Permission to use, copy, modify, and distribute this software for any
5--  purpose with or without fee is hereby granted, provided that the above
6--  copyright notice and this permission notice appear in all copies.
7--
8--  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9--  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10--  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11--  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12--  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13--  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14--  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15--
16
17
18with Ada.Directories;
19
20package body Transactions.Ghosts is
21
22   package DIR renames Ada.Directories;
23
24
25   ----------------------
26   --  scan_directory  --
27   ----------------------
28
29   function scan_directory (path : in String) return String
30   is
31      use type TIC.Column_Position;
32      justdir : constant String := DIR.Containing_Directory (path & "/") & "/";
33   begin
34      DHG.scan_for_file_ghosts (
35         directory_path   => path,
36         file_ghosts      => file_ghosts,
37         directory_ghosts => dirs_ghosts);
38
39      if dirs_ghosts.Is_Empty and file_ghosts.Is_Empty then
40         return bust;
41      end if;
42
43      TIC.Init_Screen;
44      if not TIC.Has_Colors then
45         TIC.End_Windows;
46         return nocolor;
47      end if;
48      TIC.Set_Echo_Mode (False);
49      TIC.Set_Raw_Mode (True);
50      TIC.Set_Cbreak_Mode (True);
51      if TIC.Columns > app_width then
52         app_width := TIC.Columns;
53      end if;
54      TIC.Start_Color;
55      TIC.Init_Pair (TIC.Color_Pair (1), TIC.Cyan,   TIC.Black);
56      TIC.Init_Pair (TIC.Color_Pair (2), TIC.White,  TIC.Black);
57      TIC.Init_Pair (TIC.Color_Pair (4), TIC.Black,  TIC.White);
58      TIC.Init_Pair (TIC.Color_Pair (7), TIC.Yellow, TIC.Black);
59      TIC.Init_Pair (TIC.Color_Pair (8), TIC.White,  TIC.Blue);
60      TIC.Init_Pair (TIC.Color_Pair (9), TIC.Yellow, TIC.Blue);
61      c_cyan    := TIC.Color_Pair (1);
62      c_white   := TIC.Color_Pair (2);
63      c_path    := TIC.Color_Pair (4);
64      c_yellow  := TIC.Color_Pair (7);
65      c_fcursor := TIC.Color_Pair (8);
66      c_dcursor := TIC.Color_Pair (9);
67
68      start_command_window (path);
69      start_view_window;
70      start_input_window;
71      TIC.Set_KeyPad_Mode (Win => inpwindow, SwitchOn => True);
72
73      declare
74         listing   : constant menudata := get_listing;
75         selection : Positive := 1;
76         KeyCode   : TIC.Real_Key_Code;
77         maxfiles  : constant Natural := listing'Length;
78         vheight   : constant Positive := Positive (viewheight);
79         carriage  : constant TIC.Real_Key_Code := 10;
80      begin
81         loop
82            list_deleted_entries (listing, selection);
83            show_menu (listing (selection).dir_entry = directory);
84            TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0);
85            KeyCode := TIC.Get_Keystroke (inpwindow);
86            case KeyCode is
87               when TIC.Key_Cursor_Up =>
88                  if selection > 1 then
89                     selection := selection - 1;
90                  else
91                     selection := maxfiles;
92                  end if;
93               when TIC.Key_Cursor_Down =>
94                  if selection < maxfiles then
95                     selection := selection + 1;
96                  else
97                     selection := 1;
98                  end if;
99               when TIC.Key_Cursor_Left =>
100                  if vheight < maxfiles then
101                     if selection > vheight then
102                        selection := selection - vheight;
103                     else
104                        selection := maxfiles;
105                     end if;
106                  end if;
107               when TIC.Key_Cursor_Right =>
108                  if vheight < maxfiles then
109                     if selection + vheight > maxfiles then
110                        selection := 1;
111                     else
112                        selection := selection + vheight;
113                     end if;
114                  end if;
115               when TIC.Key_F1 | Key_Num1 | carriage =>
116                  TIC.Delete (inpwindow);
117                  TIC.Delete (viewport);
118                  TIC.Delete (comwindow);
119                  TIC.End_Windows;
120                  if listing (selection).dir_entry = directory then
121                     return justdir &
122                        dirs_ghosts.Element (listing (selection).index);
123                  else
124                     return justdir &
125                        file_ghosts.Element (listing (selection).index);
126                  end if;
127               when TIC.Key_F4 | Key_Num4 =>
128                  clear_input_window;
129                  exit;
130               when others =>
131                  null;
132            end case;
133         end loop;
134      end;
135      TIC.Delete (inpwindow);
136      TIC.Delete (viewport);
137      TIC.Delete (comwindow);
138      TIC.End_Windows;
139
140      return "";
141   end scan_directory;
142
143
144   ----------------------------
145   --  start_command_window  --
146   ----------------------------
147
148   procedure start_command_window (directory_path : in String) is
149      use type TIC.Column_Count;
150      justdir : constant String := DIR.Containing_Directory
151                                   (directory_path & "/")  & "/";
152      bar     : String (1 .. Integer (app_width)) := (others => ' ');
153      maxlen  : constant Positive := Positive (app_width) - 9;
154   begin
155      comwindow := TIC.Create (
156                      Number_Of_Lines       => 2,
157                      Number_Of_Columns     => app_width + 1,
158                      First_Line_Position   => 0,
159                      First_Column_Position => 0);
160
161      TIC.Erase (Win => comwindow);
162      bar (bar'First .. bar'First + 6) := "Scanned";
163      if justdir'Length > maxlen then
164         bar (bar'First + 8 .. maxlen + 8) :=
165            justdir (justdir'First .. maxlen);
166      else
167         bar (bar'First + 8 .. justdir'Length + 8) := justdir;
168      end if;
169      TIC.Set_Character_Attributes (Win => comwindow,
170         Attr => TIC.Normal_Video, Color => TIC.Color_Pair (c_path));
171      TIC.Add (Win    => comwindow,
172               Line   => 1,
173               Column => 0,
174               Str    => bar,
175               Len    => Integer (app_width));
176   end start_command_window;
177
178
179   --------------------------
180   --  start_input_window  --
181   --------------------------
182
183   procedure start_input_window is
184      use type TIC.Line_Position;
185      use type TIC.Column_Count;
186   begin
187      inpwindow := TIC.Create (
188                      Number_Of_Lines       => 1,
189                      Number_Of_Columns     => app_width + 1,
190                      First_Line_Position   => viewheight + 2,
191                      First_Column_Position => 0);
192      TIC.Set_Character_Attributes (Win => inpwindow, Attr => bright);
193   end start_input_window;
194
195
196   -----------------------
197   --  show_page_count  --
198   -----------------------
199
200   procedure show_page_count (page : in Positive; total_pages : in Positive)
201   is
202      use type TIC.Column_Count;
203      whole_line : String (1 .. Natural (app_width)) := (others => ' ');
204      info : constant String := "page" & page'Img & " of" & total_pages'Img;
205      leftside : constant Positive := Positive (app_width) - info'Length + 1;
206   begin
207      whole_line (leftside .. whole_line'Last) := info;
208      TIC.Set_Color (Win => inpwindow, Pair => c_yellow);
209      TIC.Move_Cursor (Win => inpwindow, Line => 0, Column => 0);
210      TIC.Add (Win => inpwindow, Str => whole_line);
211      TIC.Refresh (Win => inpwindow);
212   end show_page_count;
213
214
215   --------------------------
216   --  clear_input_window  --
217   --------------------------
218
219   procedure clear_input_window is
220      blank_line : String (1 .. Natural (app_width)) := (others => ' ');
221   begin
222      TIC.Erase (Win => inpwindow);
223      TIC.Refresh (Win => inpwindow);
224   end clear_input_window;
225
226
227   -------------------------
228   --  start_view_window  --
229   -------------------------
230
231   procedure start_view_window is
232      use type TIC.Line_Position;
233      use type TIC.Column_Count;
234   begin
235      viewheight := TIC.Lines - 3;
236      if viewheight < 7 then
237         viewheight := 7;
238      end if;
239      viewport := TIC.Create (
240                      Number_Of_Lines       => viewheight,
241                      Number_Of_Columns     => app_width + 1,
242                      First_Line_Position   => 2,
243                      First_Column_Position => 0);
244   end start_view_window;
245
246
247   -----------------
248   --  show_menu  --
249   -----------------
250
251   procedure show_menu (is_directory : Boolean)
252   is
253      len  : constant Integer := Integer (app_width);
254      blank    : String (1 .. len) := ('A', 'r', 'r', 'o', 'w', 's', ':',
255                 ' ', 'm', 'o', 'v', 'e', ' ', ' ', ' ', 'F', '1', ':',
256                 others => ' ');
257
258      procedure whiten (col : in TIC.Column_Position; count : in Natural);
259      procedure whiten (col : in TIC.Column_Position; count : in Natural) is
260      begin
261         TIC.Change_Attributes (Win => comwindow, Attr => bright, Line => 0,
262            Column => col, Count => count, Color => c_white);
263      end whiten;
264   begin
265      blank (len - 7 .. blank'Last) := "F4: Quit";
266      if is_directory then
267         blank (20 .. 48) := "Select directory to resurrect";
268      else
269         blank (20 .. 42) := "Select file to undelete";
270      end if;
271      TIC.Set_Character_Attributes (Win   => comwindow,
272                                    Attr  => bright,
273                                    Color => c_cyan);
274      TIC.Add (Win    => comwindow,
275               Line   => 0,
276               Column => 0,
277               Str    => blank,
278               Len    => len);
279      whiten (0, 7);
280      whiten (15, 3);
281      whiten (TIC.Column_Position (len - 8), 3);
282      TIC.Refresh (Win => comwindow);
283
284   end show_menu;
285
286
287   -------------------
288   --  get_listing  --
289   -------------------
290
291   function get_listing return menudata
292   is
293      total   : constant Natural := Natural (dirs_ghosts.Length) +
294                   Natural (file_ghosts.Length);
295      result  : menudata (1 .. total);
296      page    : Positive := 1;
297      counter : Natural := 0;
298      row     : Natural := 0;
299   begin
300      for n in 1 .. Natural (dirs_ghosts.Length) loop
301         counter := counter + 1;
302         if row = Natural (viewheight) then
303            page := page + 1;
304            row  := 0;
305         end if;
306         result (counter).dir_entry := directory;
307         result (counter).index := n;
308         result (counter).page := page;
309         result (counter).row  := row;
310         row := row + 1;
311      end loop;
312      for n in 1 .. Natural (file_ghosts.Length) loop
313         counter := counter + 1;
314         if row = Natural (viewheight) then
315            page := page + 1;
316            row  := 0;
317         end if;
318         result (counter).dir_entry := file;
319         result (counter).index := n;
320         result (counter).page := page;
321         result (counter).row  := row;
322         row := row + 1;
323      end loop;
324      return result;
325   end get_listing;
326
327
328   ----------------------------
329   --  list_deleted_entries  --
330   ----------------------------
331
332   procedure list_deleted_entries (listing : in menudata;
333      selection : in Positive)
334   is
335      total : constant Natural := listing'Length;
336      page  : constant Positive := 1 +
337                                   ((selection - 1) / Positive (viewheight));
338      pages : constant Positive := 1 + (total / Positive (viewheight));
339      head  : constant Positive := 1 + Positive (viewheight) * (page - 1);
340      tail  : Positive := Positive (viewheight) * page;
341   begin
342      if tail > total then
343         tail := total;
344      end if;
345      TIC.Erase (Win => viewport);
346      for x in head .. tail loop
347         TIC.Move_Cursor (Win    => viewport,
348                          Column => 0,
349                          Line   => TIC.Line_Position (listing (x).row));
350         if listing (x).dir_entry = directory then
351            if selection = x then
352               TIC.Set_Character_Attributes (Win => viewport, Attr => bright,
353                  Color => c_dcursor);
354            else
355               TIC.Set_Character_Attributes (Win => viewport,
356                  Attr => TIC.Normal_Video, Color => c_cyan);
357            end if;
358            TIC.Add (Win => viewport, Str => dirs_ghosts (listing (x).index));
359         else
360            if selection = x then
361               TIC.Set_Character_Attributes (Win => viewport,
362                  Attr => TIC.Normal_Video, Color => c_fcursor);
363            else
364               TIC.Set_Character_Attributes (Win => viewport,
365                  Attr => TIC.Normal_Video, Color => c_white);
366            end if;
367            TIC.Add (Win => viewport, Str => file_ghosts (listing (x).index));
368         end if;
369      end loop;
370      TIC.Refresh (Win => viewport);
371      show_page_count (page, pages);
372   end list_deleted_entries;
373
374end Transactions.Ghosts;
375