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