├── tests ├── .gitignore ├── src │ ├── sp-memory_tests.ads │ ├── sp-strings-tests.ads │ ├── septum_tests.adb │ ├── sp-memory_tests.adb │ └── sp-strings-tests.adb ├── .vscode │ └── tasks.json ├── septum_tests.gpr └── alire.toml ├── AUTHORS ├── docs └── images │ ├── context_match.png │ ├── excluded_match.png │ └── command_overview.png ├── src ├── common │ ├── sp.ads │ ├── sp-platform.ads │ ├── sp-progress.ads │ ├── sp-debug.ads │ ├── sp-interactive.ads │ ├── sp-debug.adb │ ├── sp-config.ads │ ├── sp-progress.adb │ ├── sp-memory.adb │ ├── sp-memory.ads │ ├── septum.adb │ ├── sp-commands.ads │ ├── sp-file_system.ads │ ├── sp-contexts.ads │ ├── sp-terminal.ads │ ├── sp-cache.ads │ ├── sp-terminal.adb │ ├── sp-filters.ads │ ├── sp-contexts.adb │ ├── sp-config.adb │ ├── sp-strings.ads │ ├── sp-searches.ads │ ├── sp-filters.adb │ ├── sp-file_system.adb │ ├── sp-cache.adb │ ├── sp-strings.adb │ ├── sp-interactive.adb │ ├── sp-searches.adb │ └── sp-commands.adb ├── mac │ └── sp-platform.adb ├── windows │ └── sp-platform.adb └── linux │ └── sp-platform.adb ├── .gitignore ├── .github ├── workflows │ ├── ada.yml │ └── unit-tests.yml └── ISSUE_TEMPLATE │ ├── feature_request.md │ └── bug_report.md ├── septum.gpr ├── alire.toml ├── README.md ├── CHANGELOG.md └── LICENSE /tests/.gitignore: -------------------------------------------------------------------------------- 1 | obj/ 2 | lib/ 3 | bin/ 4 | alire/ 5 | config/ 6 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | # List of authors, last updated 5/22/2021 2 | 3 | Paul Jarrett (pyjarrett) -------------------------------------------------------------------------------- /docs/images/context_match.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyjarrett/septum/HEAD/docs/images/context_match.png -------------------------------------------------------------------------------- /docs/images/excluded_match.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyjarrett/septum/HEAD/docs/images/excluded_match.png -------------------------------------------------------------------------------- /docs/images/command_overview.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pyjarrett/septum/HEAD/docs/images/command_overview.png -------------------------------------------------------------------------------- /src/common/sp.ads: -------------------------------------------------------------------------------- 1 | package SP 2 | with Pure 3 | is 4 | 5 | Version : constant String := "0.0.8"; 6 | 7 | end SP; 8 | -------------------------------------------------------------------------------- /tests/src/sp-memory_tests.ads: -------------------------------------------------------------------------------- 1 | with Trendy_Test; 2 | 3 | package SP.Memory_Tests is 4 | 5 | function All_Tests return Trendy_Test.Test_Group; 6 | 7 | end SP.Memory_Tests; 8 | -------------------------------------------------------------------------------- /tests/src/sp-strings-tests.ads: -------------------------------------------------------------------------------- 1 | with Trendy_Test; 2 | 3 | package SP.Strings.Tests is 4 | 5 | function All_Tests return Trendy_Test.Test_Group; 6 | 7 | end SP.Strings.Tests; 8 | -------------------------------------------------------------------------------- /src/common/sp-platform.ads: -------------------------------------------------------------------------------- 1 | package SP.Platform is 2 | 3 | function Home_Dir return String; 4 | 5 | function Path_Separator return Character; 6 | function Path_Opposite_Separator return Character; 7 | 8 | end SP.Platform; 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Object file 2 | *.o 3 | *.exe 4 | 5 | # Ada Library Information 6 | *.ali 7 | 8 | # Alire things 9 | lib/ 10 | alire/ 11 | config/ 12 | obj/ 13 | alire/ 14 | bin/ 15 | 16 | # Chocolatey 17 | historical/ 18 | choco/ 19 | 20 | # Development files 21 | .clang-format 22 | .septum/obj/ 23 | -------------------------------------------------------------------------------- /src/common/sp-progress.ads: -------------------------------------------------------------------------------- 1 | with Progress_Indicators.Work_Trackers; 2 | 3 | package SP.Progress is 4 | 5 | package PI renames Progress_Indicators; 6 | 7 | task type Update_Progress (Work : access PI.Work_Trackers.Work_Tracker) with CPU => 1 is 8 | entry Stop; 9 | end Update_Progress; 10 | 11 | end SP.Progress; 12 | -------------------------------------------------------------------------------- /tests/.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "tasks": [ 4 | { 5 | "type": "gprbuild", 6 | "projectFile": "${config:ada.projectFile}", 7 | "problemMatcher": [ 8 | "$ada" 9 | ], 10 | "group": { 11 | "kind": "build", 12 | "isDefault": true 13 | }, 14 | "label": "ada: Build current project" 15 | } 16 | ] 17 | } -------------------------------------------------------------------------------- /tests/src/septum_tests.adb: -------------------------------------------------------------------------------- 1 | with SP.Memory_Tests; 2 | with SP.Strings.Tests; 3 | 4 | with Trendy_Test.Reports; 5 | 6 | procedure Septum_Tests is 7 | begin 8 | Trendy_Test.Register (SP.Memory_Tests.All_Tests); 9 | Trendy_Test.Register (SP.Strings.Tests.All_Tests); 10 | 11 | Trendy_Test.Reports.Print_Basic_Report (Trendy_Test.Run); 12 | end Septum_Tests; 13 | -------------------------------------------------------------------------------- /.github/workflows/ada.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | 3 | on: 4 | push: 5 | branches: [ main, workflows ] 6 | pull_request: 7 | branches: [ main, workflows ] 8 | 9 | jobs: 10 | build: 11 | name: CI on ${{ matrix.os }} 12 | 13 | runs-on: ${{ matrix.os }} 14 | 15 | strategy: 16 | matrix: 17 | os: [windows-latest, ubuntu-latest] 18 | 19 | steps: 20 | - name: Checkout 21 | uses: actions/checkout@v3 22 | - name: alire-project/setup-alire@v2 23 | uses: alire-project/setup-alire@v2 24 | - name: Build 25 | run: | 26 | alr --no-tty build 27 | -------------------------------------------------------------------------------- /.github/workflows/unit-tests.yml: -------------------------------------------------------------------------------- 1 | name: Unit Tests 2 | 3 | on: 4 | push: 5 | branches: [ main, workflows ] 6 | pull_request: 7 | branches: [ main, workflows ] 8 | 9 | jobs: 10 | build: 11 | name: CI on ${{ matrix.os }} 12 | 13 | runs-on: ${{ matrix.os }} 14 | 15 | strategy: 16 | matrix: 17 | os: [windows-latest, ubuntu-latest] 18 | 19 | steps: 20 | - name: Checkout 21 | uses: actions/checkout@v3 22 | - name: alire-project/setup-alire@v2 23 | uses: alire-project/setup-alire@v2 24 | - name: Build 25 | working-directory: tests/ 26 | run: | 27 | alr --no-tty build 28 | alr run 29 | -------------------------------------------------------------------------------- /src/mac/sp-platform.adb: -------------------------------------------------------------------------------- 1 | with Ada.Directories; 2 | with Ada.Environment_Variables; 3 | 4 | package body SP.Platform is 5 | 6 | function Home_Dir return String is 7 | package Env renames Ada.Environment_Variables; 8 | User_Profile : constant String := "HOME"; 9 | begin 10 | if Env.Exists (User_Profile) then 11 | return Ada.Directories.Full_Name (Env.Value (User_Profile)); 12 | else 13 | -- TODO: Add a better fallback case here. 14 | return ""; 15 | end if; 16 | end Home_Dir; 17 | 18 | function Path_Separator return Character is ('/'); 19 | function Path_Opposite_Separator return Character is ('\'); 20 | 21 | end SP.Platform; 22 | -------------------------------------------------------------------------------- /src/windows/sp-platform.adb: -------------------------------------------------------------------------------- 1 | with Ada.Directories; 2 | with Ada.Environment_Variables; 3 | 4 | package body SP.Platform is 5 | 6 | function Home_Dir return String is 7 | package Env renames Ada.Environment_Variables; 8 | User_Profile : constant String := "HOME"; 9 | begin 10 | if Env.Exists (User_Profile) then 11 | return Ada.Directories.Full_Name (Env.Value (User_Profile)); 12 | else 13 | -- TODO: Add a better fallback case here. 14 | return ""; 15 | end if; 16 | end Home_Dir; 17 | 18 | function Path_Separator return Character is ('\'); 19 | function Path_Opposite_Separator return Character is ('/'); 20 | 21 | end SP.Platform; 22 | -------------------------------------------------------------------------------- /src/linux/sp-platform.adb: -------------------------------------------------------------------------------- 1 | with Ada.Directories; 2 | with Ada.Environment_Variables; 3 | 4 | package body SP.Platform is 5 | 6 | function Home_Dir return String is 7 | package Env renames Ada.Environment_Variables; 8 | User_Profile : constant String := "USERPROFILE"; 9 | begin 10 | if Env.Exists (User_Profile) then 11 | return Ada.Directories.Full_Name (Env.Value (User_Profile)); 12 | else 13 | -- TODO: Add a better fallback case here. 14 | return ""; 15 | end if; 16 | end Home_Dir; 17 | 18 | function Path_Separator return Character is ('/'); 19 | function Path_Opposite_Separator return Character is ('\'); 20 | 21 | end SP.Platform; 22 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: "[Feature] Short description" 5 | labels: enhancement 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Is your feature request related to a problem? Please describe.** 11 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 12 | 13 | **Describe the solution you'd like** 14 | A clear and concise description of what you want to happen. 15 | 16 | **Describe alternatives you've considered** 17 | A clear and concise description of any alternative solutions or features you've considered. 18 | 19 | **Additional context** 20 | Add any other context or screenshots about the feature request here. 21 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: "[BUG] Short description" 5 | labels: bug 6 | assignees: '' 7 | 8 | --- 9 | 10 | **Describe the bug** 11 | A clear and concise description of what the bug is. 12 | 13 | **To Reproduce** 14 | Steps to reproduce the behavior: 15 | 1. Go to '...' 16 | 2. Click on '....' 17 | 3. Scroll down to '....' 18 | 4. See error 19 | 20 | **Expected behavior (if applicable)** 21 | A clear and concise description of what you expected to happen. 22 | 23 | **Screenshots** 24 | If applicable, add screenshots to help explain your problem. 25 | 26 | **Desktop (please complete the following information):** 27 | - OS: [e.g. iOS] 28 | - Version [e.g. 22] (or "Built from Source" if you compiled it yourself) 29 | 30 | **Additional context** 31 | Add any other context about the problem here. If you got a stack trace, post that here. 32 | -------------------------------------------------------------------------------- /src/common/sp-debug.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | package SP.Debug is 18 | 19 | procedure Print_Command_Line; 20 | 21 | Enabled : Boolean := False; 22 | 23 | end SP.Debug; 24 | -------------------------------------------------------------------------------- /src/common/sp-interactive.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | package SP.Interactive is 18 | 19 | procedure Main; 20 | -- Main program entry point. This hides the details of what actually happens and keeps the exterior main function 21 | -- simple. 22 | 23 | end SP.Interactive; 24 | -------------------------------------------------------------------------------- /tests/septum_tests.gpr: -------------------------------------------------------------------------------- 1 | with "atomic.gpr"; 2 | with "config/septum_tests_config.gpr"; 3 | with "trendy_test.gpr"; 4 | with "septum.gpr"; 5 | 6 | project Septum_Tests is 7 | 8 | for Source_Dirs use ("src/", "config/"); 9 | for Object_Dir use "obj/" & Septum_Tests_Config.Build_Profile; 10 | for Create_Missing_Dirs use "True"; 11 | for Exec_Dir use "bin"; 12 | for Main use ("septum_tests.adb"); 13 | 14 | package Binder is 15 | for Switches ("Ada") use ("-Es"); -- Symbolic traceback 16 | end Binder; 17 | 18 | package Pretty_Printer is 19 | for Default_Switches ("ada") use ( 20 | "-i4", -- Indentation level 21 | "-M120", -- Line length 22 | "-c0", -- Don't change comments. 23 | "--no-separate-is", 24 | "--no-separate-loop-then", 25 | "-l2" -- Compact layoud 26 | ); 27 | end Pretty_Printer; 28 | 29 | package Compiler is 30 | for Default_Switches ("Ada") use Septum_Tests_Config.Ada_Compiler_Switches; 31 | end Compiler; 32 | 33 | package Install is 34 | for Artifacts (".") use ("share"); 35 | end Install; 36 | 37 | end Septum_Tests; 38 | -------------------------------------------------------------------------------- /tests/alire.toml: -------------------------------------------------------------------------------- 1 | name = "septum_tests" 2 | description = "Tests for septum" 3 | version = "0.0.5" 4 | 5 | authors = ["Paul Jarrett"] 6 | maintainers = ["Paul Jarrett "] 7 | maintainers-logins = ["pyjarrett"] 8 | 9 | executables = ["septum_tests"] 10 | 11 | [build-switches] 12 | "*".Compile_Checks = "Warnings" 13 | "Development".Debug_Info = "Yes" 14 | "Development".Contracts = "Yes" 15 | "Development".Runtime_Checks = [ 16 | "-gnato", # Enable numeric overflow checking; 17 | "-fstack-check", # Stack overflow checking 18 | "-gnatVa", # All validity checks 19 | ] 20 | "*".Ada_Version = "Ada2022" 21 | "*".Style_Checks = [ 22 | "-gnaty-d", # Disable no DOS line terminators 23 | "-gnatyM120", # Maximum line length 24 | "-gnatyO", # Overriding subprograms explicitly marked as such] 25 | ] 26 | 27 | [[depends-on]] 28 | septum = "~0.0.8" 29 | 30 | [[depends-on]] 31 | trendy_test = "~0.0.3" 32 | 33 | # Septum deps 34 | [[depends-on]] # Added by alr 35 | dir_iterators = "~0.0.4" # Added by alr 36 | [[depends-on]] # Added by alr 37 | progress_indicators = "~0.0.1" # Added by alr 38 | [[depends-on]] # Added by alr 39 | trendy_terminal = "~0.0.5" # Added by alr 40 | 41 | [[pins]] 42 | septum = { path = ".." } 43 | #trendy_test = { url = "https://github.com/pyjarrett/trendy_test", branch="main" } 44 | #trendy_test = { path='../../trendy_test' } # Added by alr 45 | [[depends-on]] # Added by alr 46 | atomic = "~0.5.0" # Added by alr 47 | -------------------------------------------------------------------------------- /src/common/sp-debug.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Command_Line; 18 | with Ada.Integer_Text_IO; 19 | with Ada.Text_IO; 20 | 21 | package body SP.Debug is 22 | procedure Print_Command_Line is 23 | use Ada; 24 | begin 25 | Text_IO.Put_Line ("Command: " & Command_Line.Command_Name); 26 | Text_IO.Put_Line 27 | ("Arguments: " & Integer'Image (Command_Line.Argument_Count)); 28 | for Arg_Idx in 1 .. Command_Line.Argument_Count loop 29 | 30 | Integer_Text_IO.Put (Arg_Idx); 31 | Text_IO.Set_Col (5); 32 | Text_IO.Put_Line (Command_Line.Argument (Arg_Idx)); 33 | end loop; 34 | end Print_Command_Line; 35 | 36 | end SP.Debug; 37 | -------------------------------------------------------------------------------- /septum.gpr: -------------------------------------------------------------------------------- 1 | -- begin auto-gpr-with -- 2 | -- This section was automatically added by Alire 3 | with "atomic.gpr"; 4 | with "config/septum_config.gpr"; 5 | with "dir_iterators.gpr"; 6 | with "progress_indicators.gpr"; 7 | with "trendy_terminal.gpr"; 8 | -- end auto-gpr-with -- 9 | 10 | project Septum is 11 | 12 | Septum_Sources := ("src/common", "config/"); 13 | 14 | type Platform_Type is ("windows", "linux", "macos"); 15 | Platform : Platform_Type := external ("Septum_Platform"); 16 | case Platform is 17 | when "windows" => Septum_Sources := Septum_Sources & "src/windows"; 18 | when "linux" => Septum_Sources := Septum_Sources & "src/linux"; 19 | when "macos" => Septum_Sources := Septum_Sources & "src/mac"; 20 | end case; 21 | 22 | for Source_Dirs use Septum_Sources; 23 | for Object_Dir use "obj/" & Septum_Config.Build_Profile; 24 | for Create_Missing_Dirs use "True"; 25 | for Exec_Dir use "bin"; 26 | for Main use ("septum.adb"); 27 | 28 | package Binder is 29 | for Switches ("Ada") use ("-Es"); -- Symbolic traceback 30 | end Binder; 31 | 32 | package Compiler is 33 | for Default_Switches ("Ada") use Septum_Config.Ada_Compiler_Switches; 34 | end Compiler; 35 | 36 | package Pretty_Printer is 37 | for Default_Switches ("ada") use ( 38 | "-i4", -- Indentation level 39 | "-M120", -- Line length 40 | "-c0", -- Don't change comments. 41 | "--no-separate-is", 42 | "--no-separate-loop-then", 43 | "-l2" -- Compact layout 44 | ); 45 | end Pretty_Printer; 46 | 47 | package Install is 48 | for Artifacts (".") use ("share"); 49 | end Install; 50 | 51 | end Septum; 52 | -------------------------------------------------------------------------------- /src/common/sp-config.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with SP.Strings; 18 | 19 | -- Septum data is stored locally in the Next_Dir working directory on load or in the home directory of the user 20 | -- running the command. This allows users to maintain general configuration in their home directory based 21 | -- on the settings they want to work with, and then have per-project settings that they can use. 22 | -- 23 | -- Septum configuration setup. 24 | -- Containing_Directory/ 25 | -- .septum/ Directory to contain all Septum related data. 26 | -- .config Commands to run on startup. 27 | package SP.Config is 28 | use SP.Strings; 29 | 30 | Config_Dir_Name : constant String := ".septum"; 31 | Config_File_Name : constant String := "config"; 32 | 33 | -- A list of all possible locations which might have a configuration which 34 | -- can be read on program startup. 35 | function Config_Locations return String_Vectors.Vector; 36 | 37 | -- Creates a configuration in the given directory. 38 | procedure Create_Local_Config; 39 | 40 | end SP.Config; 41 | -------------------------------------------------------------------------------- /alire.toml: -------------------------------------------------------------------------------- 1 | name = "septum" 2 | description = "An interactive context-based text search tool for large codebases." 3 | version = "0.0.9" 4 | website = "https://github.com/pyjarrett/septum" 5 | 6 | authors = ["Paul Jarrett"] 7 | licenses = "Apache-2.0" 8 | maintainers = ["Paul Jarrett "] 9 | maintainers-logins = ["pyjarrett"] 10 | tags = ["search", "code", "text"] 11 | 12 | executables = ["septum"] 13 | 14 | [gpr-set-externals.'case(os)'] 15 | windows = { Septum_Platform = "windows" } 16 | linux = { Septum_Platform = "linux" } 17 | macos = { Septum_Platform = "macos" } 18 | 19 | [build-switches] 20 | Development.Debug_Info = "Yes" 21 | Development.Contracts = "Yes" 22 | Development.Runtime_Checks = [ 23 | "-gnato", # Enable numeric overflow checking; 24 | "-fstack-check", # Stack overflow checking 25 | "-gnatVa" # All validity checks 26 | ] 27 | 28 | Release.Runtime_Checks = "None" 29 | 30 | "*".Compile_Checks = "Errors" 31 | "*".Ada_Version = "Ada2022" 32 | "*".Style_Checks = [ 33 | "-gnaty-d", # Disable no DOS line terminators 34 | "-gnatyM200", # Maximum line length 35 | "-gnatyO" # Overriding subprograms explicitly marked as such] 36 | ] 37 | 38 | [[depends-on]] # Added by alr 39 | dir_iterators = "~0.0.4" # Added by alr 40 | [[depends-on]] # Added by alr 41 | progress_indicators = "~0.0.1" # Added by alr 42 | [[depends-on]] # Added by alr 43 | trendy_terminal = "~0.0.5" # Added by alr 44 | # Leaving this here to locally targeting trendy_terminal which is being 45 | # developed in parallel with this project. 46 | [[pins]] # Added by alr 47 | # For concurrent local development with trendy terminal 48 | # trendy_terminal = { path='../trendy_terminal' } # Added by alr 49 | # To be used for CI 50 | #trendy_terminal = { url = "https://github.com/pyjarrett/trendy_terminal.git", branch="main" } 51 | [[depends-on]] # Added by alr 52 | atomic = "~0.5.0" # Added by alr 53 | -------------------------------------------------------------------------------- /tests/src/sp-memory_tests.adb: -------------------------------------------------------------------------------- 1 | with SP.Memory; 2 | with Trendy_Test.Assertions.Integer_Assertions; 3 | 4 | use Trendy_Test.Assertions; 5 | use Trendy_Test.Assertions.Integer_Assertions; 6 | 7 | package body SP.Memory_Tests is 8 | 9 | type Int_Access is access Integer; 10 | package Int_Ptr is new SP.Memory (T => Integer, T_Access => Int_Access); 11 | 12 | procedure Test_Count (Op : in out Trendy_Test.Operation'Class) is 13 | begin 14 | Op.Register; 15 | 16 | declare 17 | I : Int_Ptr.Arc; 18 | J : Int_Ptr.Arc; 19 | begin 20 | Assert_EQ (Op, Integer (I.Count), 0); 21 | Assert_EQ (Op, Integer (J.Count), 0); 22 | Assert (Op, not I.Is_Valid); 23 | Assert (Op, not J.Is_Valid); 24 | 25 | I := Int_Ptr.Make (new Integer'(5)); 26 | Assert_EQ (Op, Integer (I.Count), 1); 27 | Assert_EQ (Op, Integer (J.Count), 0); 28 | Assert (Op, I.Is_Valid); 29 | Assert (Op, not J.Is_Valid); 30 | 31 | J := I; 32 | Assert_EQ (Op, Integer (I.Count), 2); 33 | Assert_EQ (Op, Integer (J.Count), 2); 34 | Assert (Op, I.Is_Valid); 35 | Assert (Op, J.Is_Valid); 36 | 37 | I.Reset; 38 | Assert_EQ (Op, Integer (I.Count), 0); 39 | Assert_EQ (Op, Integer (J.Count), 1); 40 | Assert (Op, not I.Is_Valid); 41 | Assert (Op, J.Is_Valid); 42 | 43 | J.Reset; 44 | Assert_EQ (Op, Integer (I.Count), 0); 45 | Assert_EQ (Op, Integer (J.Count), 0); 46 | Assert (Op, not I.Is_Valid); 47 | Assert (Op, not J.Is_Valid); 48 | end; 49 | end Test_Count; 50 | 51 | --------------------------------------------------------------------------- 52 | -- Test Registry 53 | --------------------------------------------------------------------------- 54 | function All_Tests return Trendy_Test.Test_Group is [ 55 | 1 => Test_Count'Access 56 | ]; 57 | 58 | end SP.Memory_Tests; 59 | -------------------------------------------------------------------------------- /src/common/sp-progress.adb: -------------------------------------------------------------------------------- 1 | with Ada.Calendar; 2 | with Ada.Strings.Fixed; 3 | with Progress_Indicators.Spinners; 4 | with SP.Terminal; 5 | with Trendy_Terminal.VT100; 6 | 7 | package body SP.Progress is 8 | 9 | task body Update_Progress is 10 | Spinner : PI.Spinners.Spinner := PI.Spinners.Make (PI.Spinners.Normal, 1); 11 | SR : PI.Work_Trackers.Status_Report; 12 | Start_Time : Ada.Calendar.Time; 13 | Current_Time : Ada.Calendar.Time; 14 | 15 | procedure Update is 16 | use all type Ada.Calendar.Time; 17 | begin 18 | Current_Time := Ada.Calendar.Clock; 19 | 20 | SP.Terminal.Beginning_Of_Line; 21 | SP.Terminal.Clear_Line; 22 | SR := Work.Report; 23 | PI.Spinners.Tick(Spinner); 24 | 25 | declare 26 | Seconds : constant Natural := Natural (Float'Rounding (100.0 * Float (Current_Time - Start_Time)) * 0.01); 27 | Elapsed : constant String := '(' & (if Seconds = 0 28 | then "<1 s" 29 | else Ada.Strings.Fixed.Trim (Seconds'Image, Ada.Strings.Left) & " s") 30 | & ')'; 31 | begin 32 | SP.Terminal.Put ( 33 | PI.Spinners.Value (Spinner) 34 | & " " 35 | & SR.Completed'Image 36 | & " done of" 37 | & SR.Total'Image 38 | & " " 39 | & Elapsed 40 | & " " 41 | & PI.Spinners.Value (Spinner)); 42 | end; 43 | end Update; 44 | begin 45 | Start_Time := Ada.Calendar.Clock; 46 | Trendy_Terminal.VT100.Hide_Cursor; 47 | loop 48 | select 49 | accept Stop; 50 | Trendy_Terminal.VT100.Show_Cursor; 51 | exit; 52 | or 53 | delay 0.2; 54 | end select; 55 | 56 | Update; 57 | end loop; 58 | end Update_Progress; 59 | 60 | end SP.Progress; 61 | -------------------------------------------------------------------------------- /src/common/sp-memory.adb: -------------------------------------------------------------------------------- 1 | package body SP.Memory is 2 | function Make (Allocated : T_Access) return Arc is 3 | begin 4 | return Arc' (Ada.Finalization.Controlled with 5 | Block => new Control_Block' ( 6 | Value => Allocated, 7 | Count => Atomic_Integer.Init (1))); 8 | end Make; 9 | 10 | function Make_Null return Arc is 11 | begin 12 | return Self : Arc do 13 | null; 14 | end return; 15 | end Make_Null; 16 | 17 | function Get (Self : Arc) return Reference_Type is 18 | begin 19 | return (Element => Self.Block.Value); 20 | end Get; 21 | 22 | function Is_Valid (Self : Arc) return Boolean is 23 | begin 24 | return Self.Block /= null and then Self.Block.Value /= null and then Atomic_Integer.Load (Self.Block.Count) > 0; 25 | end Is_Valid; 26 | 27 | procedure Reset (Self : aliased in out Arc) is 28 | begin 29 | if Self.Block /= null then 30 | if Atomic_Integer.Add_Fetch (Self.Block.Count, -1) = 0 then 31 | Free (Self.Block.Value); 32 | Free (Self.Block); 33 | else 34 | Self.Block := null; 35 | end if; 36 | end if; 37 | end Reset; 38 | 39 | function Count (Self : aliased in out Arc) return Reference_Count is 40 | begin 41 | if Self.Block /= null then 42 | return Atomic_Integer.Load (Self.Block.Count); 43 | else 44 | return 0; 45 | end if; 46 | end Count; 47 | 48 | procedure Increment (Self : in out Arc) is 49 | begin 50 | if Self.Block /= null then 51 | Atomic_Integer.Add (Self.Block.Count, 1); 52 | end if; 53 | end Increment; 54 | 55 | overriding 56 | procedure Initialize (Self : in out Arc) is 57 | begin 58 | Increment (Self); 59 | end Initialize; 60 | 61 | overriding 62 | procedure Adjust (Self : in out Arc) is 63 | begin 64 | Increment (Self); 65 | end Adjust; 66 | 67 | overriding 68 | procedure Finalize (Self : in out Arc) is 69 | begin 70 | Reset (Self); 71 | end Finalize; 72 | 73 | end SP.Memory; 74 | -------------------------------------------------------------------------------- /src/common/sp-memory.ads: -------------------------------------------------------------------------------- 1 | with Ada.Finalization; 2 | with Ada.Unchecked_Deallocation; 3 | with Atomic.Signed; 4 | 5 | generic 6 | type T (<>) is private; 7 | type T_Access is access T; 8 | package SP.Memory 9 | with Preelaborate 10 | is 11 | 12 | -- Atomic reference counting pointer. 13 | type Arc is new Ada.Finalization.Controlled with private; 14 | 15 | type Reference_Type (Element : access T) is limited null record 16 | with Implicit_Dereference => Element; 17 | 18 | type Reference_Count is new Integer; 19 | package Atomic_Integer is new Atomic.Signed (Reference_Count); 20 | 21 | function Make (Allocated : T_Access) return Arc 22 | with Post => Is_Valid (Make'Result); 23 | 24 | function Make_Null return Arc 25 | with Post => not Is_Valid (Make_Null'Result); 26 | 27 | function Is_Valid (Self : Arc) return Boolean; 28 | 29 | function Get (Self : Arc) return Reference_Type 30 | with Pre => Is_Valid (Self); 31 | 32 | procedure Reset (Self : aliased in out Arc) 33 | with Post => not Is_Valid (Self); 34 | 35 | -- Debugging function to get number of reference counts. 36 | function Count (Self : aliased in out Arc) return Reference_Count; 37 | 38 | overriding 39 | procedure Initialize (Self : in out Arc); 40 | 41 | overriding 42 | procedure Adjust (Self : in out Arc); 43 | 44 | overriding 45 | procedure Finalize (Self : in out Arc) 46 | with Post => not Is_Valid (Self); 47 | 48 | private 49 | 50 | -- The backing type which actually tracks the reference count, as well as 51 | -- tracking the value being pointed to. 52 | type Control_Block is limited record 53 | Value : T_Access := null; 54 | Count : aliased Atomic_Integer.Instance := Atomic_Integer.Init (0); 55 | end record; 56 | 57 | type Control_Block_Access is access Control_Block; 58 | 59 | type Arc is new Ada.Finalization.Controlled with record 60 | Block : Control_Block_Access := null; 61 | end record; 62 | 63 | procedure Free is new Ada.Unchecked_Deallocation (T, T_Access); 64 | procedure Free is new Ada.Unchecked_Deallocation (Control_Block, Control_Block_Access); 65 | 66 | end SP.Memory; 67 | -------------------------------------------------------------------------------- /src/common/septum.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Command_Line; 18 | with Ada.Exceptions; 19 | with Ada.Text_IO; 20 | 21 | with GNAT.Traceback.Symbolic; 22 | 23 | with SP.Config; 24 | with SP.Interactive; 25 | 26 | procedure Septum is 27 | use Ada.Text_IO; 28 | begin 29 | -- Look for a single "--version" flag 30 | if Ada.Command_Line.Argument_Count = 1 31 | and then Ada.Command_Line.Argument (1) = "--version" 32 | then 33 | Put_Line (SP.Version); 34 | return; 35 | end if; 36 | 37 | -- Create a local configuration file in the current directory. 38 | if Ada.Command_Line.Argument_Count = 1 39 | and then Ada.Command_Line.Argument (1) = "init" 40 | then 41 | SP.Config.Create_Local_Config; 42 | return; 43 | end if; 44 | 45 | -- Don't recognize any other arguments. 46 | if Ada.Command_Line.Argument_Count /= 0 then 47 | Put_Line ("Unrecognized command line arguments."); 48 | New_Line; 49 | Put_Line ("Usage: septum --version print program version"); 50 | Put_Line (" septum init creates config directory with empty config"); 51 | Put_Line (" septum run interactive search mode"); 52 | return; 53 | end if; 54 | 55 | SP.Interactive.Main; 56 | exception 57 | when Err : others => 58 | Put_Line (Ada.Exceptions.Exception_Information (Err)); 59 | Put_Line ("Exception traceback: " & GNAT.Traceback.Symbolic.Symbolic_Traceback (Err)); 60 | end Septum; 61 | -------------------------------------------------------------------------------- /src/common/sp-commands.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Strings.Unbounded; 18 | 19 | with SP.Searches; 20 | with SP.Strings; 21 | 22 | -- At its core, Septum is just a program that loads text and then executes 23 | -- commands on the current context. Whether these commands come from a user 24 | -- or a script is immaterial. 25 | package SP.Commands is 26 | pragma Elaborate_Body; 27 | 28 | use SP.Strings; 29 | use type Ada.Strings.Unbounded.Unbounded_String; 30 | 31 | -- Checks to see if a command is understood. 32 | function Is_Command (S : String) return Boolean; 33 | 34 | -- Checks to see if a command matches a known command prefix. 35 | function Is_Like_Command (S : String) return Boolean; 36 | 37 | -- Attempts to match a partially completed command against one of the 38 | -- commands understood by Septum. 39 | -- 40 | -- A completion might be ambiguous, which would result in a null string 41 | -- being returned. 42 | function Target_Command (Command_Name : ASU.Unbounded_String) return ASU.Unbounded_String 43 | with Post => Target_Command'Result = ASU.Null_Unbounded_String 44 | or else Is_Command (ASU.To_String (Target_Command'Result)); 45 | 46 | type Command_Result is ( 47 | Command_Success, 48 | Command_Failed, 49 | Command_Unknown, 50 | Command_Exit_Requested); 51 | 52 | function Run_Commands_From_File (Srch : in out SP.Searches.Search; File : String) return Command_Result; 53 | function Execute (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result; 54 | 55 | end SP.Commands; 56 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # septum 2 | 3 | [![Alire](https://img.shields.io/endpoint?url=https://alire.ada.dev/badges/septum.json)](https://alire.ada.dev/crates/septum.html) 4 | [![Build Status](https://github.com/pyjarrett/septum/actions/workflows/ada.yml/badge.svg)](https://github.com/pyjarrett/septum/actions) 5 | [![Test Status](https://github.com/pyjarrett/septum/actions/workflows/unit-tests.yml/badge.svg)](https://github.com/pyjarrett/septum/actions) 6 | 7 | Context-based code search tool 8 | 9 | # What does this do? 10 | 11 | Septum is like `grep`, but searches for matching contexts of contiguous lines, 12 | rather than just single lines. 13 | 14 | ![Include match](docs/images/context_match.png) 15 | 16 | Limiting the search into blocks around search terms allows searching for elements 17 | in arbitrary order which may span across lines, in a way which can be difficult 18 | to express in other tools. Sometimes terms appear multiple times in a project and 19 | have names which change based on context. Septum allows exclusion of these contexts. 20 | 21 | ![Exclude match](docs/images/excluded_match.png) 22 | 23 | # Why does this exist? 24 | 25 | Finding what you need in large codebases is hard. Sometimes terms have multiple 26 | meanings in different parts of the project, and figuring out what you're looking 27 | for needs to be done in an incremental fashion. 28 | 29 | Septum provides an interactive environment to push and pop search filters 30 | to narrow or expand a search. 31 | 32 | Septum is designed to be a standalone application for the lone developer on 33 | their own hardware, searching closed source software. This means the program 34 | should use a minimum number of dependencies to simplify security auditing and 35 | perform no network operations. 36 | 37 | ![Command diagram](docs/images/command_overview.png) 38 | 39 | # Example 40 | 41 | [![asciicast](https://asciinema.org/a/459292.svg)](https://asciinema.org/a/459292) 42 | 43 | # Building 44 | 45 | 1. This project requires a recent release of the [Alire](https://github.com/alire-project/alire/releases) tool to build. 46 | 2. Install a toolchain. 47 | 48 | ```bash 49 | alr toolchain --select 50 | ``` 51 | 52 | 3. Build 53 | 54 | ```bash 55 | alr build --release 56 | ``` 57 | 58 | 4. Executable should be at `bin/septum(.exe)` 59 | 60 | # Contributing 61 | 62 | Septum aims to help every developers everywhere. You're encouraged to recommend 63 | features, report bugs, or submit pull requests. 64 | 65 | # License 66 | 67 | Septum is released under the [Apache 2.0 License](http://www.apache.org/licenses/LICENSE-2.0) 68 | -------------------------------------------------------------------------------- /src/common/sp-file_system.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Directories; 18 | with SP.Strings; 19 | 20 | -- Wraps file system operations to make them simpler, and handle cases without 21 | -- using exceptions. 22 | package SP.File_System is 23 | use SP.Strings; 24 | 25 | -- Checks that a file at the given path exists. 26 | function Is_File (Target : String) return Boolean; 27 | 28 | -- Checks that a dir at the given path exists. 29 | function Is_Dir (Target : String) return Boolean; 30 | 31 | -- Ada.Directories.Hierarchical_File_Names is optional, and doesn't exist 32 | -- on some of the Linux platforms tested for Alire crates. 33 | function Is_Current_Or_Parent_Directory (Dir_Entry : Ada.Directories.Directory_Entry_Type) return Boolean; 34 | 35 | type Dir_Contents is record 36 | Files : String_Vectors.Vector; 37 | Subdirs : String_Vectors.Vector; 38 | end record; 39 | 40 | -- The immediate, non-recursive, contents of the given directory. 41 | function Contents (Dir_Name : String) return Dir_Contents; 42 | 43 | -- Pulls the contents of a textual file, which might possibly fail due to 44 | -- the file not existing or being a directory instead of a file. 45 | function Read_Lines (File_Name : in String; Result : out String_Vectors.Vector) return Boolean; 46 | 47 | -- Finds a path similar to the given one with the same basic stem. 48 | function Similar_Path (Path : String) return String; 49 | 50 | -- Rewrite a path with all forward slashes for simplicity. 51 | function Rewrite_Path (Path : String) return String; 52 | 53 | -- Produces all of the possible options for a path. 54 | function File_Completions (Path : String) return String_Vectors.Vector; 55 | 56 | end SP.File_System; 57 | -------------------------------------------------------------------------------- /src/common/sp-contexts.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Containers.Ordered_Sets; 18 | with Ada.Containers.Vectors; 19 | with Ada.Strings.Unbounded; 20 | 21 | with SP.Strings; 22 | 23 | package SP.Contexts 24 | with Preelaborate 25 | is 26 | 27 | package Line_Matches is new Ada.Containers.Ordered_Sets (Element_Type => Positive); 28 | 29 | type Context_Match is record 30 | File_Name : Ada.Strings.Unbounded.Unbounded_String; 31 | Internal_Matches : Line_Matches.Set; 32 | Minimum : Positive; 33 | Maximum : Positive; 34 | end record; 35 | 36 | function From 37 | (File_Name : String; Line : Natural; Num_Lines : Natural; Context_Width : Natural) return Context_Match with 38 | Pre => Line <= Num_Lines, 39 | Post => Is_Valid (From'Result); 40 | 41 | function Real_Min (C : Context_Match) return Positive with 42 | Pre => Is_Valid (C), 43 | Post => C.Minimum <= Real_Min'Result and then Real_Min'Result <= C.Maximum; 44 | 45 | function Real_Max (C : Context_Match) return Positive with 46 | Pre => Is_Valid (C), 47 | Post => C.Minimum <= Real_Max'Result and then Real_Max'Result <= C.Maximum; 48 | 49 | function Is_Valid (C : Context_Match) return Boolean; 50 | 51 | function Overlap (A, B : Context_Match) return Boolean with 52 | Pre => Is_Valid (A) and then Is_Valid (B); 53 | 54 | function Contains (A : Context_Match; Line_Num : Positive) return Boolean with 55 | Pre => Is_Valid (A); 56 | 57 | function Contains (A, B : Context_Match) return Boolean with 58 | Pre => Is_Valid (A) and then Is_Valid (B); 59 | 60 | function Merge (A, B : Context_Match) return Context_Match with 61 | Pre => Is_Valid (A) and then Is_Valid (B), 62 | Post => Is_Valid (Merge'Result); 63 | 64 | function Image (A : Context_Match) return String with 65 | Pre => Is_Valid (A); 66 | 67 | overriding 68 | function "="(A, B : Context_Match) return Boolean with 69 | Pre => Is_Valid (A) and then Is_Valid (B); 70 | 71 | package Context_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Context_Match); 72 | 73 | function Files_In (V : Context_Vectors.Vector) return SP.Strings.String_Sets.Set; 74 | 75 | end SP.Contexts; 76 | -------------------------------------------------------------------------------- /src/common/sp-terminal.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Strings.Unbounded; 18 | with ANSI; 19 | 20 | with Trendy_Terminal.IO; 21 | with Trendy_Terminal.VT100; 22 | 23 | package SP.Terminal is 24 | -- Functions for operations to the terminal. This hides the usage of Ada.Text_IO and may silently ignore 25 | -- capabilities if the terminal does not support them, such as if coloring text or line clearing is added. 26 | -- 27 | -- This module also hides dependencies on unbounded IO. 28 | 29 | procedure Put (C : Character) renames Trendy_Terminal.IO.Put; 30 | procedure Put (Str : String) renames Trendy_Terminal.IO.Put; 31 | procedure Put (Str : Ada.Strings.Unbounded.Unbounded_String) renames Trendy_Terminal.IO.Put; 32 | 33 | procedure Put_Line (Str : String) renames Trendy_Terminal.IO.Put_Line; 34 | procedure Put_Line (Str : Ada.Strings.Unbounded.Unbounded_String) renames Trendy_Terminal.IO.Put_Line; 35 | 36 | procedure New_Line (Spacing : Positive := 1) renames Trendy_Terminal.IO.New_Line; 37 | 38 | procedure Set_Col (Spacing : Positive) renames Trendy_Terminal.IO.Set_Col; 39 | 40 | procedure Beginning_Of_Line renames Trendy_Terminal.VT100.Beginning_Of_Line; 41 | procedure Clear_Line renames Trendy_Terminal.VT100.Clear_Line; 42 | 43 | function Colorize (S : String; Color : ANSI.Colors) return String; 44 | function Colorize (US : Ada.Strings.Unbounded.Unbounded_String; Color : ANSI.Colors) 45 | return Ada.Strings.Unbounded.Unbounded_String; 46 | 47 | -- I'm not convinced that these aren't useful. I haven't figured out how best to deal with the really long and 48 | -- verbose terminology of Ada.Strings.Unbounded.Unbounded_String. 49 | 50 | -- function "&" (A : String; B : Unbounded_String) return Unbounded_String renames Ada.Strings.Unbounded."&"; 51 | -- function "&" (Ada : Unbounded_String; B : String) return Unbounded_String renames Ada.Strings.Unbounded."&"; 52 | 53 | protected type Cancellation_Gate is 54 | entry Closed; 55 | procedure Finish; 56 | procedure Cancel; 57 | function Is_Cancelled return Boolean; 58 | function Is_Finished return Boolean; 59 | private 60 | Cancelled : Boolean := False; 61 | Finished : Boolean := False; 62 | end Cancellation_Gate; 63 | 64 | task type Terminal_Cancellation_Monitor(Gate : not null access Cancellation_Gate) is 65 | entry Cancel; 66 | entry Stop; 67 | end; 68 | end SP.Terminal; 69 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 4 | but adds emojis. 5 | 6 | Types of changes: 7 | 8 | - ✅ `Added` for new features. 9 | - 🔄 `Changed` for changes in existing functionality. 10 | - ⚠️ `Deprecated` for soon-to-be removed features. 11 | - ❌ `Removed` for now removed features. 12 | - 🛠️ `Fixed` for any bug fixes. 13 | - 💥💥💥 `Security` in case of vulnerabilities. Triple 💥 for emphasis. 14 | 15 | ## [0.0.7] 16 | 17 | - ✅ Added useful startup commands to .septum/config when running `init` 18 | - ✅ Added preliminary mac support. 19 | - 🛠️ Fixed some linux issues. 20 | 21 | ## [0.0.6] 22 | 23 | - ✅ Added coloration of file names in search results. 24 | 25 | ## [0.0.5] 26 | 27 | - 🛠️ Fixed crash when tab completing an empty command. 28 | 29 | ## [0.0.4] 30 | 31 | - 🔄 **BREAKING CHANGE!** config file name from `.config` to `config`. 32 | - ✅ Added `drop` command to remove filters out of order. 33 | - ✅ Added `reorder` command to change filter application order. 34 | - ✅ Added filter list to the prompt. 35 | - ✅ Added up arrow to scroll through history. 36 | - 🛠️ Fixed jumping/blinking cursor when predicting commands. 37 | - 🛠️ Fixed jumping/blinking cursor in progress update. 38 | 39 | ## [0.0.3] 40 | 41 | - 🛠️ Fixed tab crash on Linux. 42 | - 🛠️ Fixed case of slow output in certain Linux terminals. 43 | 44 | ## [0.0.1-beta3] 45 | 46 | - ✅ Added `test` command to see which filters will match. 47 | - ✅ Added `--version` command to print the executable version. 48 | - ✅ Added duration reporting and progress spinners to search. 49 | - 🛠️ Fixed `source` command to prevent cyclic inclusion of scripts. 50 | - 🛠️ Fixed issue where max results would be ignored. 51 | - 🛠️ Fixed issue where `pop` would crash. 52 | 53 | ## [0.0.1-beta2] 54 | 55 | - ✅ Added pinning of load and search tasks to CPUs. 56 | - ✅ Added tab completion for directories in `add-dirs`. 57 | - ✅ Added coloration of regular expressions: 🔴red🔴 when invalid, and 🟢green🟢 when valid. 58 | - ✅ Added progress indication during searches. 59 | - ✅ Added `source` command to run commands from file. 60 | - ✅ Added program termination if UTF-8 or VT100 cannot be enabled. 61 | - 🔄 Changed completions to sort lexicographically. 62 | - 🔄 Changed `match-contexts` to accept optional `first` argument. 63 | - ❌ Removed dependency on GNATColl. 64 | - ❌ Removed dependency on `Ada.Directories.Hierarchical_File_Names`. 65 | - 🛠️ Fixed Regex filter display to show "Regex". 66 | 67 | ## [0.0.1-beta] 68 | 69 | - ✅ Added hinting for commands. 70 | - ✅ Added tab-completion for commands. 71 | - ✅ Added coloration of matching lines with `enable-line-colors`. 72 | - 🛠️ Fixed crash bug on pasting text into input. 73 | - 🛠️ Fixed crash bug on existing input when prompt shows up. 74 | 75 | ## [0.0.1-alpha11] 76 | 77 | - ✅ Added input coloration. Commands run 🔴red🔴 when invalid, 🟡yellow🟡 when matching a valid prefix, and 🟢green🟢 when correct. 78 | - ✅ Added input coloration. Paths turn 🔵blue🔵 when valid. 79 | 80 | ## [0.0.1-alpha10] 81 | 82 | - ✅ Added `find-like` and `exclude-like` for case-insensitive search. 83 | - ✅ Added internal crate under tests/ using Trendy Test for tests. 84 | - 🛠️ Fixed auto-search to not always when disabled. 85 | - 🛠️ Fixed crash when no .septum/ folder exists in starting directory. 86 | -------------------------------------------------------------------------------- /tests/src/sp-strings-tests.adb: -------------------------------------------------------------------------------- 1 | with Ada.Characters.Latin_1; 2 | with Ada.Strings.Unbounded; 3 | with Trendy_Test.Assertions.Integer_Assertions; 4 | 5 | package body SP.Strings.Tests is 6 | 7 | package ASU renames Ada.Strings.Unbounded; 8 | 9 | use Trendy_Test.Assertions; 10 | use Trendy_Test.Assertions.Integer_Assertions; 11 | 12 | function "+" (S : String) return ASU.Unbounded_String renames ASU.To_Unbounded_String; 13 | 14 | procedure Test_String_Split (Op : in out Trendy_Test.Operation'Class) is 15 | E : Exploded_Line; 16 | begin 17 | Op.Register; 18 | 19 | E := Make (" this is an exploded line with--content "); 20 | 21 | Assert_EQ (Op, Num_Words (E), 6); 22 | Assert_EQ (Op, Get_Word (E, 1), "this"); 23 | Assert_EQ (Op, Get_Word (E, 2), "is"); 24 | Assert_EQ (Op, Get_Word (E, 3), "an"); 25 | Assert_EQ (Op, Get_Word (E, 4), "exploded"); 26 | Assert_EQ (Op, Get_Word (E, 5), "line"); 27 | Assert_EQ (Op, Get_Word (E, 6), "with--content"); 28 | end Test_String_Split; 29 | 30 | procedure Test_Is_Quoted (Op : in out Trendy_Test.Operation'Class) is 31 | use Ada.Characters.Latin_1; 32 | begin 33 | Op.Register; 34 | 35 | Assert (Op, not Is_Quoted("")); 36 | Assert (Op, not Is_Quoted ("not quoted")); 37 | 38 | -- Unbalanced " 39 | Assert (Op, not Is_Quoted (Quotation & "some text")); 40 | Assert (Op, not Is_Quoted ("some text" & Quotation)); 41 | 42 | -- Unbalanced ' 43 | Assert (Op, not Is_Quoted (Apostrophe & "some text")); 44 | Assert (Op, not Is_Quoted ("some text" & Apostrophe)); 45 | 46 | -- Mismatched ' and " 47 | Assert (Op, not Is_Quoted (Quotation & "some text" & Apostrophe)); 48 | Assert (Op, not Is_Quoted (Apostrophe & "some text" & Quotation)); 49 | 50 | -- Matched " and ' 51 | Assert (Op, Is_Quoted (Apostrophe & "some text" & Apostrophe)); 52 | Assert (Op, Is_Quoted (Quotation & "some text" & Quotation)); 53 | 54 | -- Internal " or ' 55 | Assert (Op, Is_Quoted (Apostrophe & Quotation & "some text" & Quotation & Apostrophe)); 56 | Assert (Op, Is_Quoted (Apostrophe & Quotation & "some text" & Quotation & Apostrophe)); 57 | end Test_Is_Quoted; 58 | 59 | procedure Test_Common_Prefix_Length (Op : in out Trendy_Test.Operation'Class) is 60 | package Trendy_TestI renames Trendy_Test.Assertions.Integer_Assertions; 61 | begin 62 | Op.Register; 63 | 64 | Trendy_TestI.Assert_EQ (Op, Common_Prefix_Length(+"", +"SP.Strings"), 0); 65 | Assert_EQ (Op, Common_Prefix_Length(+"SP.Strings", +""), 0); 66 | Assert_EQ (Op, Common_Prefix_Length(+"", +""), 0); 67 | 68 | Assert_EQ (Op, Common_Prefix_Length(+"SP.Searches", +"SP.Strings"), 4); 69 | Assert_EQ (Op, Common_Prefix_Length(+"SP.Strings", +"SP.Strings"), ASU.Length (+"SP.Strings")); 70 | end Test_Common_Prefix_Length; 71 | 72 | --------------------------------------------------------------------------- 73 | -- Test Registry 74 | --------------------------------------------------------------------------- 75 | function All_Tests return Trendy_Test.Test_Group is [ 76 | Test_String_Split'Access, 77 | Test_Is_Quoted'Access, 78 | Test_Common_Prefix_Length'Access 79 | ]; 80 | 81 | end SP.Strings.Tests; 82 | -------------------------------------------------------------------------------- /src/common/sp-cache.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with SP.Strings; 18 | with Ada.Containers.Ordered_Maps; 19 | with Ada.Strings.Unbounded; 20 | 21 | -- Super simple text file caching. 22 | -- 23 | -- While `Async_File_Cache` provides parallel loading, access to the cache 24 | -- itself is protected. 25 | -- 26 | -- Provides a means to load entire directory structures into memory and then 27 | -- use it as needed. This is intended for text files only, in particular, to 28 | -- speed text searches of large read-only code bases. 29 | -- 30 | -- This is super simple and straightforward, but works well enough. 31 | -- It probably better done with mmap to load files directly to memory. It 32 | -- eliminates line-splitting when printing output. If this were in C++, 33 | -- it would be possible to do something like store the file as a huge byte 34 | -- block with mmap and then replace newlines with '\0' and store byte counts 35 | -- to the initial part of every string. 36 | -- 37 | package SP.Cache is 38 | 39 | use Ada.Strings.Unbounded; 40 | use SP.Strings; 41 | 42 | package File_Maps is new Ada.Containers.Ordered_Maps ( 43 | Key_Type => Ada.Strings.Unbounded.Unbounded_String, 44 | Element_Type => String_Vectors.Vector, 45 | "<" => Ada.Strings.Unbounded."<", "=" => String_Vectors."="); 46 | 47 | -- The available in-memory contents of files loaded from files. 48 | -- 49 | -- Files are stored by full path name, with the OS's preference for path 50 | -- separators. 51 | -- 52 | -- TODO: Add monitoring of files for changes. 53 | protected type Async_File_Cache is 54 | 55 | procedure Clear; 56 | 57 | -- Cache the contents of a file, replacing any existing contents. 58 | procedure Cache_File (File_Name : Unbounded_String; Lines : String_Vectors.Vector); 59 | 60 | -- The total number of loaded files in the file cache. 61 | function Num_Files return Natural; 62 | 63 | -- The total number of loaded lines in the file cache. 64 | function Num_Lines return Natural; 65 | 66 | function Lines (File_Name : Unbounded_String) return String_Vectors.Vector; 67 | 68 | function Files return String_Vectors.Vector; 69 | 70 | function File_Line (File_Name : Unbounded_String; Line : Positive) return Unbounded_String; 71 | 72 | private 73 | 74 | -- A list of all top level directories which need to be searched. 75 | Top_Level_Directories : SP.Strings.String_Sets.Set; 76 | 77 | Contents : File_Maps.Map; 78 | end Async_File_Cache; 79 | 80 | -- Adds a directory and all of its recursive subdirectories into the file cache. 81 | function Add_Directory_Recursively (A : in out Async_File_Cache; Dir : String) return Boolean; 82 | 83 | end SP.Cache; 84 | -------------------------------------------------------------------------------- /src/common/sp-terminal.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Trendy_Terminal.Platform; 18 | with Trendy_Terminal.Maps; 19 | 20 | package body SP.Terminal is 21 | 22 | function Colorize (S : String; Color : ANSI.Colors) return String is 23 | begin 24 | return ANSI.Foreground (Color) 25 | & S 26 | & ANSI.Foreground (ANSI.Default); 27 | end Colorize; 28 | 29 | function Colorize (US : Ada.Strings.Unbounded.Unbounded_String; Color : ANSI.Colors) 30 | return Ada.Strings.Unbounded.Unbounded_String 31 | is 32 | use all type Ada.Strings.Unbounded.Unbounded_String; 33 | begin 34 | return ANSI.Foreground (Color) 35 | & US 36 | & ANSI.Foreground (ANSI.Default); 37 | end Colorize; 38 | 39 | protected body Cancellation_Gate is 40 | entry Closed when Finished is 41 | begin 42 | null; 43 | end Closed; 44 | 45 | procedure Cancel is 46 | begin 47 | Cancelled := True; 48 | end Cancel; 49 | 50 | function Is_Cancelled return Boolean is 51 | begin 52 | return Cancelled; 53 | end Is_Cancelled; 54 | 55 | procedure Finish is 56 | begin 57 | Finished := True; 58 | end Finish; 59 | 60 | function Is_Finished return Boolean is 61 | begin 62 | return Finished; 63 | end Is_Finished; 64 | end Cancellation_Gate; 65 | 66 | task body Terminal_Cancellation_Monitor is 67 | task Input_Thread is end; 68 | 69 | task body Input_Thread is 70 | use all type Trendy_Terminal.Maps.Key; 71 | begin 72 | loop 73 | declare 74 | Input : constant String := Trendy_Terminal.Platform.Get_Input; 75 | begin 76 | if Trendy_Terminal.Maps.Key_For (Input) = Trendy_Terminal.Maps.Key_Ctrl_C then 77 | select 78 | Cancel; 79 | exit; 80 | else 81 | null; 82 | end select; 83 | elsif Trendy_Terminal.Maps.Key_For (Input) = Trendy_Terminal.Maps.Key_Ctrl_D then 84 | exit; 85 | else 86 | null; 87 | end if; 88 | end; 89 | end loop; 90 | end Input_Thread; 91 | 92 | Done : Boolean := False; 93 | begin 94 | loop 95 | select 96 | accept Cancel do 97 | Done := True; 98 | Gate.Cancel; 99 | end; 100 | or 101 | accept Stop do 102 | Done := True; 103 | end; 104 | or 105 | terminate; 106 | end select; 107 | 108 | exit when Done; 109 | end loop; 110 | 111 | abort Input_Thread; 112 | end Terminal_Cancellation_Monitor; 113 | 114 | end SP.Terminal; -------------------------------------------------------------------------------- /src/common/sp-filters.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Containers.Vectors; 18 | with Ada.Strings.Unbounded; 19 | with GNAT.Regpat; 20 | with SP.Contexts; 21 | with SP.Memory; 22 | with SP.Strings; 23 | 24 | package SP.Filters 25 | with Preelaborate 26 | is 27 | use SP.Strings; 28 | 29 | -- Filters need to do different things. Some filters match line contents, whereas others want to remove any match 30 | -- which has a match anywhere in the content. When a filter matches, some action with regards to the search should 31 | -- be done, whether to include or to exclude the match from the results. 32 | type Filter_Action is (Keep, Exclude); 33 | 34 | -- Search filters define which lines match and what to do about a match. 35 | type Filter (Action : Filter_Action) is abstract tagged null record; 36 | 37 | -- Describes the filter in an end-user type of way. TODO: This should be localized. 38 | function Image (F : Filter) return String is abstract; 39 | 40 | -- Determine if a filter matches a string. 41 | function Matches_Line (F : Filter; Str : String) return Boolean is abstract; 42 | 43 | type Filter_Access is access Filter'Class; 44 | package Pointers is new SP.Memory (T => Filter'Class, T_Access => Filter_Access); 45 | 46 | subtype Filter_Ptr is Pointers.Arc; 47 | 48 | -- Provides a means to store many types of filters in the same list. 49 | package Filter_List is new Ada.Containers.Vectors 50 | (Index_Type => Positive, Element_Type => Filter_Ptr, "=" => Pointers."="); 51 | 52 | 53 | function Find_Text (Text : String) return Filter_Ptr; 54 | function Exclude_Text (Text : String) return Filter_Ptr; 55 | 56 | function Find_Like (Text : String) return Filter_Ptr; 57 | function Exclude_Like (Text : String) return Filter_Ptr; 58 | 59 | function Find_Regex (Text : String) return Filter_Ptr; 60 | function Exclude_Regex (Text : String) return Filter_Ptr; 61 | 62 | function Is_Valid_Regex (S : String) return Boolean; 63 | 64 | -- Looks for a match in any of the given lines. 65 | function Matches_File (F : Filter'Class; Lines : String_Vectors.Vector) return Boolean; 66 | function Matching_Lines (F : Filter'Class; Lines : String_Vectors.Vector) return SP.Contexts.Line_Matches.Set; 67 | 68 | private 69 | 70 | type Regex_Access is access GNAT.Regpat.Pattern_Matcher; 71 | package Rc_Regex is new SP.Memory (T => GNAT.Regpat.Pattern_Matcher, T_Access => Regex_Access); 72 | 73 | type Case_Sensitive_Match_Filter is new Filter with record 74 | Text : Ada.Strings.Unbounded.Unbounded_String; 75 | end record; 76 | 77 | type Case_Insensitive_Match_Filter is new Filter with record 78 | Text : Ada.Strings.Unbounded.Unbounded_String; 79 | end record; 80 | 81 | type Regex_Filter is new Filter with record 82 | Source : Ada.Strings.Unbounded.Unbounded_String; 83 | Regex : Rc_Regex.Arc; 84 | end record; 85 | 86 | overriding function Image (F : Case_Sensitive_Match_Filter) return String; 87 | overriding function Matches_Line (F : Case_Sensitive_Match_Filter; Str : String) return Boolean; 88 | 89 | overriding function Image (F : Case_Insensitive_Match_Filter) return String; 90 | overriding function Matches_Line (F : Case_Insensitive_Match_Filter; Str : String) return Boolean; 91 | 92 | overriding function Image (F : Regex_Filter) return String; 93 | overriding function Matches_Line (F : Regex_Filter; Str : String) return Boolean; 94 | 95 | end SP.Filters; 96 | -------------------------------------------------------------------------------- /src/common/sp-contexts.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | package body SP.Contexts is 18 | 19 | function From 20 | (File_Name : String; Line : Natural; Num_Lines : Natural; Context_Width : Natural) return Context_Match is 21 | Minimum : constant Positive := 22 | (if Context_Width > Num_Lines or else Line - Context_Width < 1 then 1 else Line - Context_Width); 23 | Maximum : constant Positive := 24 | (if Context_Width > Num_Lines or else Line + Context_Width > Num_Lines then Num_Lines 25 | else Line + Context_Width); 26 | begin 27 | return C : Context_Match do 28 | C.File_Name := Ada.Strings.Unbounded.To_Unbounded_String (File_Name); 29 | C.Internal_Matches.Insert (Line); 30 | C.Minimum := Minimum; 31 | C.Maximum := Maximum; 32 | end return; 33 | end From; 34 | 35 | function Is_Valid (C : Context_Match) return Boolean is 36 | begin 37 | return 38 | (C.Minimum <= C.Maximum and then not C.Internal_Matches.Is_Empty 39 | and then C.Minimum <= C.Internal_Matches.First_Element 40 | and then C.Internal_Matches.Last_Element <= C.Maximum); 41 | end Is_Valid; 42 | 43 | function Real_Min (C : Context_Match) return Positive is (C.Internal_Matches.First_Element); 44 | function Real_Max (C : Context_Match) return Positive is (C.Internal_Matches.Last_Element); 45 | 46 | function Overlap (A, B : Context_Match) return Boolean is 47 | A_To_Left_Of_B : constant Boolean := A.Maximum < B.Minimum; 48 | A_To_Right_Of_B : constant Boolean := B.Maximum < A.Minimum; 49 | New_Min : constant Positive := Positive'Max (A.Minimum, B.Minimum); 50 | New_Max : constant Positive := Positive'Min (A.Maximum, B.Maximum); 51 | use Ada.Strings.Unbounded; 52 | begin 53 | return 54 | A.File_Name = B.File_Name and then not (A_To_Left_Of_B or else A_To_Right_Of_B) 55 | and then 56 | (New_Min <= Real_Min (A) and then New_Min <= Real_Min (B) and then Real_Max (A) <= New_Max 57 | and then Real_Max (B) <= New_Max); 58 | end Overlap; 59 | 60 | function Contains (A : Context_Match; Line_Num : Positive) return Boolean is 61 | begin 62 | return A.Minimum <= Line_Num and then Line_Num <= A.Maximum; 63 | end Contains; 64 | 65 | function Contains (A, B : Context_Match) return Boolean is 66 | -- Does A fully contain B? 67 | use type Ada.Strings.Unbounded.Unbounded_String; 68 | begin 69 | return A.File_Name = B.File_Name and then A.Minimum <= B.Minimum and then B.Maximum <= A.Maximum; 70 | end Contains; 71 | 72 | function Merge (A, B : Context_Match) return Context_Match is 73 | use Line_Matches; 74 | begin 75 | return C : Context_Match do 76 | C.File_Name := A.File_Name; 77 | C.Internal_Matches := A.Internal_Matches or B.Internal_Matches; 78 | C.Minimum := Positive'Max (A.Minimum, B.Minimum); 79 | C.Maximum := Positive'Min (A.Maximum, B.Maximum); 80 | end return; 81 | end Merge; 82 | 83 | function Image (A : Context_Match) return String is 84 | use Ada.Strings.Unbounded; 85 | begin 86 | return 87 | To_String 88 | (A.File_Name & ": " & A.Minimum'Image & " -> " & A.Maximum'Image & " " & 89 | A.Internal_Matches.Length'Image & " matches"); 90 | end Image; 91 | 92 | overriding 93 | function "=" (A, B : Context_Match) return Boolean is 94 | use Ada.Strings.Unbounded; 95 | use SP.Contexts.Line_Matches; 96 | begin 97 | return 98 | A.File_Name = B.File_Name and then A.Minimum = B.Minimum and then B.Maximum = A.Maximum 99 | and then A.Internal_Matches = B.Internal_Matches; 100 | end "="; 101 | 102 | function Files_In (V : Context_Vectors.Vector) return SP.Strings.String_Sets.Set is 103 | begin 104 | return Files : SP.Strings.String_Sets.Set do 105 | for Context of V loop 106 | if not Files.Contains (Context.File_Name) then 107 | Files.Insert (Context.File_Name); 108 | end if; 109 | end loop; 110 | end return; 111 | end Files_In; 112 | 113 | end SP.Contexts; 114 | -------------------------------------------------------------------------------- /src/common/sp-config.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Directories; 18 | with Ada.Strings.Unbounded; 19 | with Ada.Text_IO; 20 | with Dir_Iterators.Ancestor; 21 | with SP.File_System; 22 | with SP.Platform; 23 | 24 | package body SP.Config is 25 | package AD renames Ada.Directories; 26 | package ASU renames Ada.Strings.Unbounded; 27 | package FS renames SP.File_System; 28 | 29 | use type ASU.Unbounded_String; 30 | 31 | procedure Create_Local_Config is 32 | Current_Dir : constant String := AD.Current_Directory; 33 | Config_Dir : constant String := Current_Dir & "/" & Config_Dir_Name; 34 | Config_File : constant String := Config_Dir & "/" & Config_File_Name; 35 | begin 36 | if not AD.Exists (Config_Dir) then 37 | begin 38 | AD.Create_Directory (Config_Dir); 39 | exception 40 | when AD.Name_Error | AD.Use_Error => 41 | return; 42 | end; 43 | end if; 44 | 45 | if SP.File_System.Is_File (Config_File) 46 | or else SP.File_System.Is_Dir (Config_File) then 47 | Ada.Text_IO.Put_Line ("Unable to create config file, something already exists there: " & 48 | Config_File); 49 | return; 50 | end if; 51 | 52 | declare 53 | File : Ada.Text_IO.File_Type; 54 | begin 55 | Ada.Text_IO.Create (File, Ada.Text_IO.Out_File, Config_File); 56 | Ada.Text_IO.Put_Line (File, "enable-line-numbers"); 57 | Ada.Text_IO.Put_Line (File, "enable-line-colors"); 58 | Ada.Text_IO.Put_Line (File, "set-max-results 200"); 59 | declare 60 | Current_Dir : constant String := Ada.Directories.Full_Name(Ada.Directories.Current_Directory); 61 | begin 62 | Ada.Text_IO.Put_Line (File, "add-dirs " & Current_Dir); 63 | exception 64 | when Ada.Directories.Use_Error => null; 65 | end; 66 | Ada.Text_IO.Close (File); 67 | 68 | -- Compiler bug? 69 | -- warning: "File" modified by call, but value might not be referenced 70 | pragma Unreferenced (File); 71 | 72 | Ada.Text_IO.Put_Line ("Configuration directory: " & Ada.Directories.Full_Name (Config_Dir)); 73 | Ada.Text_IO.Put_Line ("Configuration file: " & Ada.Directories.Full_Name (Config_File)); 74 | Ada.Text_IO.New_Line; 75 | Ada.Text_IO.Put_Line (Config_Dir_Name & " is for Septum settings and configuration."); 76 | Ada.Text_IO.Put_Line (Config_File_Name & " contains commands to run when starting in this directory."); 77 | exception 78 | when Ada.Text_IO.Name_Error | Ada.Text_IO.Use_Error => 79 | Ada.Text_IO.Put_Line ("Unable to create configuration file."); 80 | end; 81 | end Create_Local_Config; 82 | 83 | -- Finds the config which is the closest ancestor to the given directory. 84 | function Closest_Config (Dir_Name : String) return ASU.Unbounded_String with 85 | Pre => AD.Exists (Dir_Name), 86 | Post => (Closest_Config'Result = ASU.Null_Unbounded_String) 87 | or else FS.Is_File (ASU.To_String (Closest_Config'Result)) 88 | is 89 | Ancestors : constant Dir_Iterators.Ancestor.Ancestor_Dir_Walk := Dir_Iterators.Ancestor.Walk (Dir_Name); 90 | Next_Trial : ASU.Unbounded_String; 91 | begin 92 | for Ancestor of Ancestors loop 93 | Next_Trial := ASU.To_Unbounded_String (Ancestor & "/" & Config_Dir_Name & "/" & Config_File_Name); 94 | if FS.Is_File (ASU.To_String (Next_Trial)) then 95 | return Next_Trial; 96 | end if; 97 | end loop; 98 | return ASU.Null_Unbounded_String; 99 | end Closest_Config; 100 | 101 | function Config_Locations return String_Vectors.Vector is 102 | Home_Dir_Config : constant ASU.Unbounded_String := 103 | ASU.To_Unbounded_String 104 | (SP.Platform.Home_Dir & "/" & Config_Dir_Name & "/" & Config_File_Name); 105 | Current_Dir_Config : constant ASU.Unbounded_String := Closest_Config (Ada.Directories.Current_Directory); 106 | begin 107 | return V : String_Vectors.Vector do 108 | -- Look for the global user config. 109 | if FS.Is_File (ASU.To_String (Home_Dir_Config)) then 110 | V.Append (Home_Dir_Config); 111 | end if; 112 | 113 | if Current_Dir_Config /= ASU.Null_Unbounded_String 114 | and then FS.Is_File (ASU.To_String (Current_Dir_Config)) 115 | then 116 | V.Append (Current_Dir_Config); 117 | end if; 118 | end return; 119 | end Config_Locations; 120 | end SP.Config; 121 | -------------------------------------------------------------------------------- /src/common/sp-strings.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Containers.Ordered_Sets; 18 | with Ada.Containers.Vectors; 19 | with Ada.Strings.Unbounded; 20 | 21 | -- A lot of what happens in Septum is related to strings. It reads them from 22 | -- file, uses them as input for commands, looks for them with filters, attempts 23 | -- to match them with regular expressions and prints them to users. 24 | -- 25 | -- ## UTF-8 Compatibility 26 | -- 27 | -- Any solution to handling all of these in a UTF-8 compatible manner, must 28 | -- then deal appropriately with all of the interfaces with which these things 29 | -- touch. Due to the tight binding within Septum of all of these behaviors, 30 | -- it may not be possible to extricate enough of string handling for a drop in 31 | -- replacement, and a complete refactoring to properly handle UTF-8 in all 32 | -- situations may be impossible. 33 | -- 34 | -- The binding of strings to fixed sizes also remains painful, as it requires 35 | -- the use of an additional unbounded type, and often semantically meaningless 36 | -- and inefficient conversions between the two types. In many situations, 37 | -- fixed strings aren't possible, such as being stored in vectors, sets or used 38 | -- as keys in maps. This often results in doubling the size of the interface, 39 | -- or clumsily converting as needed. 40 | -- 41 | -- My approach thus far has been to write interfaces using `String` as much as 42 | -- possible, falling back to unbounded strings only when absolutely necessary. 43 | -- There is likely a considerable amount of time needed to convert due to this 44 | -- approach. 45 | -- 46 | -- What I probably should have done initially was to define a private string 47 | -- type to use everywhere with easy conversions and use either string interning 48 | -- or underlying unbounded strings. The current form of `Unbounded_String` is 49 | -- also somewhat unwieldly. 50 | -- 51 | -- The [VSS](https://github.com/AdaCore/VSS) library looks like a viable 52 | -- alternative to `Unbounded_String`, though it is marked with "Warning: This is 53 | -- experimental work in progress, everything is subject to change. It may be or 54 | -- may be not part of GNATCOLL or standard Ada library in the future." 55 | -- 56 | -- Known systems which use strings: 57 | -- - Terminal I/O (Trendy Terminal) 58 | -- - Formatting 59 | -- - Hinting system 60 | -- - Autocomplete 61 | -- - Search 62 | -- - Regular expressions 63 | -- - File I/O 64 | -- - Command interpretation 65 | -- 66 | package SP.Strings 67 | with Preelaborate 68 | is 69 | package ASU renames Ada.Strings.Unbounded; 70 | 71 | package String_Sets is new Ada.Containers.Ordered_Sets 72 | (Element_Type => ASU.Unbounded_String, "<" => ASU."<", 73 | "=" => ASU."="); 74 | package String_Vectors is new Ada.Containers.Vectors 75 | (Index_Type => Positive, Element_Type => ASU.Unbounded_String, 76 | "=" => ASU."="); 77 | 78 | function Zip (Left, Right : String_Vectors.Vector) return ASU.Unbounded_String; 79 | function Format_Array (S : String_Vectors.Vector) return ASU.Unbounded_String; 80 | 81 | function Common_Prefix_Length (A, B : ASU.Unbounded_String) return Natural 82 | with 83 | Post => Common_Prefix_Length'Result <= Natural'Max (ASU.Length (A), ASU.Length (B)); 84 | 85 | function Matching_Suffix (Current, Desired : ASU.Unbounded_String) return ASU.Unbounded_String; 86 | 87 | -- Quoted strings must start and end with either a single or a double quote. 88 | function Is_Quoted (S : String) return Boolean; 89 | 90 | function Split_Command (Input : ASU.Unbounded_String) return SP.Strings.String_Vectors.Vector; 91 | 92 | -- An exploded form of a line which allows the line to be recombined 93 | -- transparently to a user, by reapplying the appropriate amounts and types 94 | -- of spacing between words. 95 | -- 96 | -- This looks like: 97 | -- [_space_]*[WORD][_space_][WORD][_space_][WORD][_space_] 98 | -- 99 | -- To prevent complications regarding whether a word or space is first, and 100 | -- simplify iteration over words, the leading space is always stored, and 101 | -- may be empty. 102 | type Exploded_Line is record 103 | -- The first space is "Leading spacing" 104 | -- Spaces(i) is what preceeds Words(i) 105 | Spacers : String_Vectors.Vector; 106 | Words : String_Vectors.Vector; 107 | end record; 108 | 109 | -- TODO: This will eventually need to be rewritten to account for multi-byte 110 | -- sequences in UTF-8. Incurring technical debt here on purpose to try to get 111 | -- the command line formatter stood up more quickly. 112 | function Make (S : String) return Exploded_Line; 113 | function Get_Word (E : Exploded_Line; Index : Positive) return String is (ASU.To_String (E.Words.Element (Index))); 114 | function Num_Words (E : Exploded_Line) return Natural is (Natural (E.Words.Length)); 115 | 116 | function Get_Cursor_Word (E : SP.Strings.Exploded_Line; Cursor_Position : Positive) return Natural; 117 | function Cursor_Position_At_End_Of_Word (E : SP.Strings.Exploded_Line; Word : Positive) return Positive; 118 | 119 | end SP.Strings; 120 | -------------------------------------------------------------------------------- /src/common/sp-searches.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | with Ada.Containers.Vectors; 17 | 18 | with SP.Cache; 19 | with SP.Contexts; 20 | with SP.Filters; 21 | with SP.Strings; 22 | 23 | package SP.Searches is 24 | use SP.Strings; 25 | 26 | type Search is limited private; 27 | 28 | package Positive_Vectors is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Positive); 29 | 30 | function Reload_Working_Set (Srch : in out Search) return Boolean; 31 | -- Dumps currently loaded search text and loads it again. 32 | 33 | function Add_Directory (Srch : in out Search; Dir_Name : String) return Boolean; 34 | 35 | function List_Directories (Srch : in Search) return String_Vectors.Vector; 36 | -- Lists top level search directories. 37 | procedure Clear_Directories (Srch : in out Search) 38 | with Post => List_Directories (Srch).Is_Empty; 39 | 40 | procedure Add_Extension (Srch : in out Search; Extension : String); 41 | procedure Remove_Extension (Srch : in out Search; Extension : String); 42 | procedure Clear_Extensions (Srch : in out Search); 43 | function List_Extensions (Srch : in Search) return String_Vectors.Vector; 44 | 45 | procedure Find_Text (Srch : in out Search; Text : String); 46 | 47 | procedure Exclude_Text (Srch : in out Search; Text : String); 48 | 49 | procedure Find_Like (Srch : in out Search; Text : String); 50 | 51 | procedure Exclude_Like (Srch : in out Search; Text : String); 52 | 53 | procedure Find_Regex (Srch : in out Search; Text : String); 54 | 55 | procedure Exclude_Regex (Srch : in out Search; Text : String); 56 | 57 | procedure Drop_Filter (Srch : in out Search; Index : Positive); 58 | 59 | procedure Pop_Filter (Srch : in out Search); 60 | -- Undoes the last search operations. 61 | 62 | procedure Reorder_Filters (Srch : in out Search; Indices : Positive_Vectors.Vector) 63 | with Pre => (for all Index of Indices => Natural (Index) <= Num_Filters (Srch)) 64 | and then (Natural (Indices.Length) = Num_Filters (Srch)) 65 | and then (for all I in 1 .. Num_Filters (Srch) => Indices.Contains (I)); 66 | 67 | procedure Clear_Filters (Srch : in out Search); 68 | 69 | No_Context_Width : constant := Natural'Last; 70 | procedure Set_Context_Width (Srch : in out Search; Context_Width : Natural); 71 | function Get_Context_Width (Srch : in Search) return Natural; 72 | 73 | No_Max_Results : constant := Natural'Last; 74 | procedure Set_Max_Results (Srch : in out Search; Max_Results : Natural); 75 | function Get_Max_Results (Srch : in Search) return Natural; 76 | 77 | procedure Set_Search_On_Filters_Changed (Srch : in out Search; Enabled : Boolean); 78 | function Get_Search_On_Filters_Changed (Srch : in out Search) return Boolean; 79 | 80 | procedure Set_Line_Colors_Enabled (Srch : in out Search; Enabled : Boolean); 81 | 82 | procedure Set_Print_Line_Numbers (Srch : in out Search; Enabled : Boolean); 83 | function Get_Print_Line_Numbers (Srch : in Search) return Boolean; 84 | 85 | function List_Filter_Names (Srch : in Search) return String_Vectors.Vector; 86 | function Num_Filters (Srch : in Search) return Natural; 87 | 88 | function Matching_Contexts (Srch : in Search) return SP.Contexts.Context_Vectors.Vector; 89 | 90 | No_Limit : constant := Natural'Last; 91 | procedure Print_Contexts ( 92 | Srch : in Search; 93 | Contexts : SP.Contexts.Context_Vectors.Vector; 94 | First : Natural; 95 | Last : Natural); 96 | 97 | procedure Print_Contexts_With_Cancellation( 98 | Srch : in Search; 99 | Contexts : SP.Contexts.Context_Vectors.Vector; 100 | First : Natural; 101 | Last : Natural); 102 | 103 | function Num_Files (Srch : in Search) return Natural; 104 | function Num_Lines (Srch : in Search) return Natural; 105 | 106 | protected type Concurrent_Context_Results is 107 | entry Get_Results(Out_Results : out SP.Contexts.Context_Vectors.Vector); 108 | procedure Wait_For(Num_Results : Natural); 109 | procedure Add_Result(More : SP.Contexts.Context_Vectors.Vector); 110 | private 111 | Pending_Results : Natural := 0; 112 | Results : SP.Contexts.Context_Vectors.Vector; 113 | end Concurrent_Context_Results; 114 | 115 | function Is_Running_Script (Srch : Search; Script_Path : String) return Boolean; 116 | procedure Push_Script (Srch : in out Search; Script_Path : String) 117 | with Pre => not Is_Running_Script (Srch, Script_Path); 118 | procedure Pop_Script (Srch : in out Search; Script_Path : String) 119 | with Pre => Is_Running_Script (Srch, Script_Path); 120 | 121 | procedure Test (Srch : Search; Input : String); 122 | 123 | private 124 | 125 | use SP.Filters; 126 | 127 | -- The lines which match can determine the width of the context to be saved. 128 | 129 | type Search is limited record 130 | Directories : String_Sets.Set; 131 | -- A list of all directories to search. 132 | 133 | File_Cache : SP.Cache.Async_File_Cache; 134 | -- Cached contents of files. 135 | 136 | Line_Filters : Filter_List.Vector; 137 | 138 | Extensions : String_Sets.Set; 139 | 140 | Context_Width : Natural := 7;-- No_Context_Width; 141 | 142 | Max_Results : Natural := No_Max_Results; 143 | 144 | Print_Line_Numbers : Boolean := True; 145 | 146 | Search_On_Filters_Changed : Boolean := False; 147 | 148 | Enable_Line_Colors : Boolean := False; 149 | 150 | -- The stack of currently executing scripts. 151 | -- Intuitively this is a stack, but a set should work just a well, 152 | -- since the focus is the membership test. 153 | Script_Stack : String_Sets.Set; 154 | end record; 155 | 156 | end SP.Searches; 157 | -------------------------------------------------------------------------------- /src/common/sp-filters.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Characters.Latin_1; 18 | with Ada.Strings.Fixed; 19 | with Ada.Strings.Maps.Constants; 20 | 21 | package body SP.Filters is 22 | use Ada.Strings.Unbounded; 23 | 24 | function To_Upper_Case (Text : String) return String is 25 | use Ada.Strings.Maps; 26 | begin 27 | return Ada.Strings.Fixed.Translate (Text, Constants.Upper_Case_Map); 28 | end To_Upper_Case; 29 | 30 | function Find_Text (Text : String) return Filter_Ptr is 31 | begin 32 | return Pointers.Make (new Case_Sensitive_Match_Filter' (Action => Keep, Text => To_Unbounded_String (Text))); 33 | end Find_Text; 34 | 35 | function Exclude_Text (Text : String) return Filter_Ptr is 36 | begin 37 | return Pointers.Make (new Case_Sensitive_Match_Filter' (Action => Exclude, Text => To_Unbounded_String (Text))); 38 | end Exclude_Text; 39 | 40 | function Find_Like (Text : String) return Filter_Ptr is 41 | begin 42 | return Pointers.Make (new Case_Insensitive_Match_Filter' ( 43 | Action => Keep, 44 | Text => To_Unbounded_String (To_Upper_Case (Text)))); 45 | end Find_Like; 46 | 47 | function Exclude_Like (Text : String) return Filter_Ptr is 48 | begin 49 | return Pointers.Make (new Case_Insensitive_Match_Filter' ( 50 | Action => Exclude, 51 | Text => To_Unbounded_String (To_Upper_Case (Text)))); 52 | end Exclude_Like; 53 | 54 | function Find_Regex (Text : String) return Filter_Ptr is 55 | Matcher : Rc_Regex.Arc; 56 | begin 57 | Matcher := Rc_Regex.Make (new GNAT.Regpat.Pattern_Matcher'(GNAT.Regpat.Compile (Text))); 58 | return Pointers.Make (new Regex_Filter' (Action => Keep, Source => To_Unbounded_String(Text), Regex => Matcher)); 59 | exception 60 | -- Unable to compile the regular expression. 61 | when GNAT.Regpat.Expression_Error => 62 | return Pointers.Make_Null; 63 | end Find_Regex; 64 | 65 | function Exclude_Regex (Text : String) return Filter_Ptr is 66 | Matcher : Rc_Regex.Arc; 67 | begin 68 | Matcher := Rc_Regex.Make (new GNAT.Regpat.Pattern_Matcher'(GNAT.Regpat.Compile (Text))); 69 | return Pointers.Make (new Regex_Filter' (Action => Exclude, Source => To_Unbounded_String(Text), Regex => Matcher)); 70 | exception 71 | -- Unable to compile the regular expression. 72 | when GNAT.Regpat.Expression_Error => 73 | return Pointers.Make_Null; 74 | end Exclude_Regex; 75 | 76 | ---------------------------------------------------------------------------- 77 | 78 | function Is_Valid_Regex (S : String) return Boolean is 79 | begin 80 | declare 81 | Matcher : constant GNAT.Regpat.Pattern_Matcher := GNAT.Regpat.Compile (S); 82 | begin 83 | pragma Unreferenced (Matcher); 84 | null; 85 | end; 86 | return True; 87 | exception 88 | when GNAT.Regpat.Expression_Error => 89 | return False; 90 | end Is_Valid_Regex; 91 | 92 | ---------------------------------------------------------------------------- 93 | 94 | overriding function Image (F : Case_Sensitive_Match_Filter) return String is 95 | use Ada.Characters; 96 | begin 97 | return "Case Sensitive Match " & Latin_1.Quotation & To_String (F.Text) & Latin_1.Quotation; 98 | end Image; 99 | 100 | overriding function Matches_Line (F : Case_Sensitive_Match_Filter; Str : String) return Boolean is 101 | begin 102 | return Ada.Strings.Fixed.Index (Str, To_String (F.Text)) > 0; 103 | end Matches_Line; 104 | 105 | ---------------------------------------------------------------------------- 106 | 107 | overriding function Image (F : Case_Insensitive_Match_Filter) return String is 108 | use Ada.Characters; 109 | begin 110 | return "Case Insensitive Match " & Latin_1.Quotation & To_String (F.Text) & Latin_1.Quotation; 111 | end Image; 112 | 113 | overriding function Matches_Line (F : Case_Insensitive_Match_Filter; Str : String) return Boolean is 114 | Upper_Cased : constant String := To_Upper_Case (Str); 115 | begin 116 | return Ada.Strings.Fixed.Index (Upper_Cased, To_String (F.Text)) > 0; 117 | end Matches_Line; 118 | 119 | ---------------------------------------------------------------------------- 120 | 121 | overriding function Image (F : Regex_Filter) return String is 122 | begin 123 | return "Regex " & Ada.Strings.Unbounded.To_String (F.Source); 124 | end Image; 125 | 126 | overriding function Matches_Line (F : Regex_Filter; Str : String) return Boolean is 127 | begin 128 | return GNAT.Regpat.Match (F.Regex.Get, Str); 129 | end Matches_Line; 130 | 131 | ---------------------------------------------------------------------------- 132 | 133 | function Matches_File (F : Filter'Class; Lines : String_Vectors.Vector) return Boolean is 134 | Match : constant Boolean := (for some Line of Lines => Matches_Line (F, To_String (Line))); 135 | begin 136 | case F.Action is 137 | when Keep => 138 | return Match; 139 | when Exclude => 140 | return not Match; 141 | end case; 142 | end Matches_File; 143 | 144 | ---------------------------------------------------------------------------- 145 | 146 | function Matching_Lines (F : Filter'Class; Lines : String_Vectors.Vector) return SP.Contexts.Line_Matches.Set is 147 | Line_Num : Integer := 1; 148 | begin 149 | return L : SP.Contexts.Line_Matches.Set do 150 | for Line of Lines loop 151 | if Matches_Line (F, To_String (Line)) then 152 | L.Insert (Line_Num); 153 | end if; 154 | Line_Num := Line_Num + 1; 155 | end loop; 156 | end return; 157 | end Matching_Lines; 158 | 159 | end SP.Filters; 160 | -------------------------------------------------------------------------------- /src/common/sp-file_system.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.IO_Exceptions; 18 | with Ada.Strings.Unbounded.Text_IO; 19 | with Ada.Text_IO; 20 | 21 | with SP.Platform; 22 | with SP.Terminal; 23 | 24 | package body SP.File_System is 25 | 26 | package AD renames Ada.Directories; 27 | 28 | function Is_File (Target : String) return Boolean is 29 | use type Ada.Directories.File_Kind; 30 | begin 31 | return AD.Exists (Target) and then AD.Kind (Target) = AD.Ordinary_File; 32 | exception 33 | when others => 34 | return False; 35 | end Is_File; 36 | 37 | function Is_Dir (Target : String) return Boolean is 38 | use type Ada.Directories.File_Kind; 39 | begin 40 | return AD.Exists (Target) and then AD.Kind (Target) = AD.Directory; 41 | exception 42 | when others => 43 | return False; 44 | end Is_Dir; 45 | 46 | function Is_Current_Or_Parent_Directory (Dir_Entry : Ada.Directories.Directory_Entry_Type) return Boolean is 47 | -- Return true if the entry is "." or "..". 48 | Name : constant String := Ada.Directories.Simple_Name (Dir_Entry); 49 | begin 50 | return Name = "." or else Name = ".."; 51 | end Is_Current_Or_Parent_Directory; 52 | 53 | function Contents (Dir_Name : String) return Dir_Contents is 54 | use Ada.Directories; 55 | Dir_Search : Search_Type; 56 | Next_Entry : Directory_Entry_Type; 57 | Filter : constant Filter_Type := [Ordinary_File | Directory => True, others => False]; 58 | begin 59 | return Result : Dir_Contents do 60 | Ada.Directories.Start_Search 61 | (Search => Dir_Search, Directory => Dir_Name, Pattern => "*", Filter => Filter); 62 | while More_Entries (Dir_Search) loop 63 | Get_Next_Entry (Dir_Search, Next_Entry); 64 | if not Is_Current_Or_Parent_Directory (Next_Entry) then 65 | case Kind (Next_Entry) is 66 | when Directory => Result.Subdirs.Append (Ada.Strings.Unbounded.To_Unbounded_String(Full_Name (Next_Entry))); 67 | when Ordinary_File => Result.Files.Append (Ada.Strings.Unbounded.To_Unbounded_String(Full_Name (Next_Entry))); 68 | when others => null; 69 | end case; 70 | end if; 71 | end loop; 72 | End_Search (Dir_Search); 73 | end return; 74 | end Contents; 75 | 76 | -- Reads all the lines from a file. 77 | function Read_Lines (File_Name : String; Result : out String_Vectors.Vector) return Boolean is 78 | File : Ada.Text_IO.File_Type; 79 | Line : Ada.Strings.Unbounded.Unbounded_String; 80 | begin 81 | String_Vectors.Clear (Result); 82 | Ada.Text_IO.Open (File => File, Mode => Ada.Text_IO.In_File, Name => File_Name); 83 | while not Ada.Text_IO.End_Of_File (File) loop 84 | Line := Ada.Strings.Unbounded.Text_IO.Get_Line (File); 85 | Result.Append (Line); 86 | end loop; 87 | 88 | Ada.Text_IO.Close (File); 89 | return True; 90 | exception 91 | when Ada.Text_IO.End_Error => 92 | if Ada.Text_IO.Is_Open (File) then 93 | Ada.Text_IO.Close (File); 94 | end if; 95 | return True; 96 | when others => 97 | SP.Terminal.Put_Line ("Unable to read contents of: " & File_Name); 98 | return False; 99 | end Read_Lines; 100 | 101 | -- Finds a path similar to the given one with the same basic stem. 102 | function Similar_Path (Path : String) return String is 103 | begin 104 | -- TODO: This is bad. 105 | -- Naive loop cutting off the end of the string one character at a time. 106 | for Last_Index in reverse 2 .. Path'Length loop 107 | declare 108 | Shortened_Path : constant String := Path (Path'First .. Last_Index); 109 | begin 110 | if Is_File (Shortened_Path) then 111 | return Shortened_Path; 112 | elsif Is_Dir (Shortened_Path) then 113 | return Shortened_Path; 114 | end if; 115 | end; 116 | end loop; 117 | return ""; 118 | exception 119 | when others => return ""; 120 | end Similar_Path; 121 | 122 | -- Rewrite a path with all forward slashes for simplicity. 123 | function Rewrite_Path (Path : String) return String is 124 | S : String := Path; 125 | Opposite : constant Character := SP.Platform.Path_Opposite_Separator; 126 | Local : constant Character := SP.Platform.Path_Separator; 127 | begin 128 | for I in 1 .. S'Length loop 129 | if (Path (I) = Opposite) then 130 | S(I) := Local; 131 | else 132 | S(I) := Path (I); 133 | end if; 134 | end loop; 135 | return S; 136 | end Rewrite_Path; 137 | 138 | -- Produces all of the possible options for a path. 139 | function File_Completions (Path : String) return SP.Strings.String_Vectors.Vector 140 | is 141 | Result : SP.Strings.String_Vectors.Vector; 142 | Files : Dir_Contents; 143 | Rewritten : ASU.Unbounded_String := ASU.To_Unbounded_String (Rewrite_Path (Path)); 144 | Similar : ASU.Unbounded_String := ASU.To_Unbounded_String (Similar_Path (ASU.To_String (Rewritten))); 145 | begin 146 | -- Has no higher directory. 147 | if ASU.Length (Similar) = 0 then 148 | return Result; 149 | end if; 150 | 151 | begin 152 | if (Is_Dir (ASU.To_String (Similar)) 153 | and then ASU.Element (Similar, ASU.Length (Similar)) = SP.Platform.Path_Separator) 154 | or else ASU.Length (Similar) = 1 155 | then 156 | Files := Contents (ASU.To_String (Similar)); 157 | else 158 | declare 159 | Parent : constant ASU.Unbounded_String := ASU.To_Unbounded_String (Similar_Path (ASU.Slice (Similar, 1, ASU.Length (Similar) - 1))); 160 | begin 161 | if not Is_Dir (ASU.To_String (Parent)) then 162 | return Result; 163 | end if; 164 | 165 | Files := Contents (ASU.To_String (Parent)); 166 | Similar := Parent; 167 | Rewritten := ASU.To_Unbounded_String (Rewrite_Path (ASU.To_String (Similar))); 168 | end; 169 | end if; 170 | exception 171 | -- Skip over files we're not allowed to read. 172 | when Ada.IO_Exceptions.Use_Error => 173 | null; 174 | end; 175 | 176 | 177 | -- The directory file contain paths with similar completions to the name. 178 | -- Filter out paths which don't have a matching prefix with the original. 179 | for Dir of Files.Subdirs loop 180 | if SP.Strings.Common_Prefix_Length (Rewritten, Dir) = ASU.Length (Rewritten) then 181 | Result.Append (Dir); 182 | end if; 183 | end loop; 184 | 185 | return Result; 186 | end File_Completions; 187 | 188 | end SP.File_System; 189 | -------------------------------------------------------------------------------- /src/common/sp-cache.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Containers.Synchronized_Queue_Interfaces; 18 | with Ada.Containers.Unbounded_Synchronized_Queues; 19 | with Ada.Directories; 20 | 21 | with SP.File_System; 22 | with SP.Progress; 23 | with SP.Terminal; 24 | 25 | with System.Multiprocessors.Dispatching_Domains; 26 | 27 | with Dir_Iterators.Recursive; 28 | with Progress_Indicators.Work_Trackers; 29 | 30 | package body SP.Cache is 31 | function Is_Text (File_Name : String) return Boolean is 32 | -- This is probably better written to look at encoding (such as invalid sequences in UTF-8, etc.) 33 | -- instead of being a hodgepodge of various formats I know that I care about right now. 34 | -- TODO: Adding more file types I care about now, this needs to be fixed properly. 35 | Extension : String renames Ada.Directories.Extension (File_Name); 36 | begin 37 | return Extension in 38 | "ads" | -- Ada 39 | "adb" | 40 | "c" | -- c 41 | "h" | 42 | "cpp" | -- C++ 43 | "C" | 44 | "cc" | 45 | "hpp" | 46 | "hh" | 47 | "inl" | 48 | "lock" | 49 | "toml" | 50 | "cs" | -- C# 51 | "hs" | -- Haskell 52 | "py" | -- Python 53 | "rs"; -- Rust 54 | end Is_Text; 55 | 56 | procedure Cache_File (File_Cache : in out Async_File_Cache; File_Name : Ada.Strings.Unbounded.Unbounded_String) is 57 | Lines : String_Vectors.Vector := String_Vectors.Empty_Vector; 58 | begin 59 | if SP.File_System.Read_Lines (To_String (File_Name), Lines) then 60 | File_Cache.Cache_File (File_Name, Lines); 61 | end if; 62 | end Cache_File; 63 | 64 | protected body Async_File_Cache is 65 | procedure Clear is 66 | begin 67 | Contents.Clear; 68 | end Clear; 69 | 70 | procedure Cache_File (File_Name : in Unbounded_String; Lines : in String_Vectors.Vector) is 71 | begin 72 | if Contents.Contains (File_Name) then 73 | SP.Terminal.Put_Line ("Replacing contents of " & To_String (File_Name)); 74 | Contents.Replace (File_Name, Lines); 75 | else 76 | Contents.Insert (File_Name, Lines); 77 | end if; 78 | end Cache_File; 79 | 80 | function Num_Files return Natural is 81 | begin 82 | return Natural (Contents.Length); 83 | end Num_Files; 84 | 85 | function Num_Lines return Natural is 86 | begin 87 | return N : Natural := 0 do 88 | for Cursor in Contents.Iterate loop 89 | N := N + Natural (File_Maps.Element (Cursor).Length); 90 | end loop; 91 | end return; 92 | end Num_Lines; 93 | 94 | function Lines (File_Name : in Unbounded_String) return String_Vectors.Vector is 95 | begin 96 | return Contents (File_Name); 97 | end Lines; 98 | 99 | function Files return String_Vectors.Vector is 100 | begin 101 | return Result : String_Vectors.Vector do 102 | for Cursor in Contents.Iterate loop 103 | Result.Append (SP.Cache.File_Maps.Key (Cursor)); 104 | end loop; 105 | end return; 106 | end Files; 107 | 108 | function File_Line (File_Name : in Unbounded_String; Line : in Positive) return Unbounded_String is 109 | begin 110 | return Contents.Element (File_Name).Element (Line); 111 | end File_Line; 112 | 113 | end Async_File_Cache; 114 | 115 | -- Adds all directories to the file cache. 116 | -- 117 | -- Most users will probably only have source on a single medium, so 118 | -- parallelizing the load probably won't improve speed. The split of 119 | -- parsing tasks is to support more complicated caching methods in the 120 | -- future, as we're I/O bound here based on the disk speed. 121 | function Add_Directory_Recursively ( 122 | A : in out Async_File_Cache; 123 | Dir : String) return Boolean 124 | is 125 | package String_Queue_Interface is new Ada.Containers.Synchronized_Queue_Interfaces 126 | (Element_Type => Ada.Strings.Unbounded.Unbounded_String); 127 | package String_Unbounded_Queue is new Ada.Containers.Unbounded_Synchronized_Queues 128 | (Queue_Interfaces => String_Queue_Interface); 129 | 130 | File_Queue : String_Unbounded_Queue.Queue; 131 | 132 | package PI renames Progress_Indicators; 133 | Progress : aliased PI.Work_Trackers.Work_Tracker; 134 | begin 135 | declare 136 | -- A directory loading task builds a queue of files to parse for the 137 | -- file loader tasks. 138 | task Dir_Loader_Task with CPU => 1 is end; 139 | 140 | task body Dir_Loader_Task is 141 | Dir_Walk : constant Dir_Iterators.Recursive.Recursive_Dir_Walk := Dir_Iterators.Recursive.Walk (Dir); 142 | use type Ada.Directories.File_Kind; 143 | begin 144 | for Dir_Entry of Dir_Walk loop 145 | if Ada.Directories.Kind (Dir_Entry) = Ada.Directories.Ordinary_File then 146 | File_Queue.Enqueue 147 | (Ada.Strings.Unbounded.To_Unbounded_String (Ada.Directories.Full_Name (Dir_Entry))); 148 | Progress.Start_Work (1); 149 | end if; 150 | end loop; 151 | end Dir_Loader_Task; 152 | 153 | task type File_Loader_Task is 154 | entry Wake; 155 | end File_Loader_Task; 156 | 157 | task body File_Loader_Task is 158 | Elem : Ada.Strings.Unbounded.Unbounded_String; 159 | begin 160 | loop 161 | -- Allowing queueing of many tasks, some of which might not be used, but will not prevent the 162 | -- program from continuing. 163 | select 164 | accept Wake; 165 | or 166 | terminate; 167 | end select; 168 | 169 | loop 170 | select 171 | File_Queue.Dequeue (Elem); 172 | or 173 | delay 1.0; 174 | exit; 175 | end select; 176 | 177 | if Is_Text (To_String (Elem)) then 178 | Cache_File (A, Elem); 179 | end if; 180 | Progress.Finish_Work (1); 181 | end loop; 182 | end loop; 183 | end File_Loader_Task; 184 | 185 | Progress_Tracker : SP.Progress.Update_Progress (Progress'Access); 186 | Num_CPUs : constant System.Multiprocessors.CPU := System.Multiprocessors.Number_Of_CPUs; 187 | begin 188 | SP.Terminal.Put_Line ("Loading with" & Num_CPUs'Image & " tasks."); 189 | SP.Terminal.New_Line; 190 | 191 | declare 192 | File_Loader : array (1 .. Num_CPUs) of File_Loader_Task; 193 | begin 194 | for I in File_Loader'Range loop 195 | begin 196 | System.Multiprocessors.Dispatching_Domains.Set_CPU (I, File_Loader(I)'Identity); 197 | exception 198 | when System.Multiprocessors.Dispatching_Domains.Dispatching_Domain_Error => null; 199 | end; 200 | File_Loader(I).Wake; 201 | end loop; 202 | end; 203 | 204 | Progress_Tracker.Stop; 205 | SP.Terminal.New_Line; 206 | 207 | return True; 208 | end; 209 | end Add_Directory_Recursively; 210 | 211 | end SP.Cache; 212 | -------------------------------------------------------------------------------- /src/common/sp-strings.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | with Ada.Strings.Fixed; 17 | with Ada.Characters.Latin_1; 18 | 19 | package body SP.Strings is 20 | function Zip (Left : SP.Strings.String_Vectors.Vector; Right : SP.Strings.String_Vectors.Vector) 21 | return Ada.Strings.Unbounded.Unbounded_String 22 | is 23 | use Ada.Strings.Unbounded; 24 | use SP.Strings.String_Vectors; 25 | L : Natural := 1; 26 | R : Natural := 1; 27 | begin 28 | return Result : Ada.Strings.Unbounded.Unbounded_String do 29 | while L <= Natural (Length (Left)) or else R <= Natural (Length (Right)) loop 30 | if L <= Natural (Length (Left)) then 31 | Append (Result, Left (L)); 32 | L := L + 1; 33 | end if; 34 | 35 | if R <= Natural (Length (Right)) then 36 | Append (Result, Right (R)); 37 | R := R + 1; 38 | end if; 39 | end loop; 40 | end return; 41 | end Zip; 42 | 43 | function Format_Array (S : SP.Strings.String_Vectors.Vector) return Ada.Strings.Unbounded.Unbounded_String is 44 | use Ada.Strings.Unbounded; 45 | Result : Unbounded_String; 46 | begin 47 | Append (Result, To_Unbounded_String ("[")); 48 | for Elem of S loop 49 | Append (Result, Ada.Characters.Latin_1.Quotation); 50 | Append (Result, Elem); 51 | Append (Result, Ada.Characters.Latin_1.Quotation); 52 | Append (Result, Ada.Characters.Latin_1.Comma); 53 | Append (Result, To_Unbounded_String (" ")); 54 | end loop; 55 | Append (Result, To_Unbounded_String ("]")); 56 | return Result; 57 | end Format_Array; 58 | 59 | -- TODO: This will eventually need to be rewritten to account for multi-byte 60 | -- sequences in UTF-8. Incurring technical debt here on purpose to try to get 61 | -- the command line formatter stood up more quickly. 62 | function Make (S : String) return Exploded_Line is 63 | -- Use half-open ranges here. The next slice is going to be 64 | -- [First, After_Last). This allows "empty" ranges when Fire = After_Last. 65 | After_Last : Natural := 1; 66 | Result : Exploded_Line; 67 | 68 | use Ada.Strings.Unbounded; 69 | begin 70 | if S'Length = 0 then 71 | return E : Exploded_Line do null; end return; 72 | end if; 73 | 74 | while After_Last <= S'Length loop 75 | -- This section is a spacer since, either a new line is being split 76 | -- or this is starting a whitespace section after consuming some text. 77 | -- 78 | -- To reduce special casing, empty leading space is added to the 79 | -- exploded line, this maintains the property that Spacers(i) is what 80 | -- preceeds Words(i). 81 | declare 82 | First : constant Natural := After_Last; 83 | begin 84 | After_Last := Ada.Strings.Fixed.Index_Non_Blank (S, After_Last); 85 | 86 | -- No more text follows the whitespace. 87 | exit when After_Last = 0; 88 | 89 | Result.Spacers.Append (To_Unbounded_String (S (First .. After_Last - 1))); 90 | exit when After_Last > S'Length; 91 | end; 92 | 93 | -- A non-space section, as designated as starting with a non-blank character. 94 | -- This section is trickier as multiple cases have to be resolved. 95 | -- 1. Dealing with quoted sections. Once a quoted section has started, 96 | -- it can only be undone by an unescaped quoted character. 97 | -- 2. Escaped characters. Escaped spaces might appear which hamper the 98 | -- ability to delineate words by spaces alone. 99 | -- 3. Don't run off the end of the string. 100 | -- 101 | -- N.B the usage of / on Windows is commonplace, so requiring uses 102 | -- to use / or \\ for a "\" seems reasonable. 103 | -- 104 | -- In practice, spaces appear quite often in queries, especially when looking 105 | -- for error messages and some Window directories. 106 | declare 107 | Escaped : Boolean := False; 108 | Quoted : Boolean := False; 109 | Quote_Char : Character := ' '; 110 | Next_Char : Character; 111 | Word : Unbounded_String; 112 | begin 113 | while After_Last <= S'Length loop 114 | Next_Char := S (After_Last); 115 | 116 | -- The previous character was escaped, so treat the next 117 | -- character as a literal. 118 | -- 119 | -- This appears before quote checks to prevent escaped 120 | -- quotes from changing the quote state. 121 | if Escaped then 122 | Append (Word, Next_Char); 123 | Escaped := False; 124 | else 125 | case Next_Char is 126 | when '\' => 127 | Escaped := True; 128 | Append (Word, Next_Char); 129 | when Ada.Characters.Latin_1.Quotation => 130 | if not Quoted then 131 | Quoted := True; 132 | Quote_Char := Ada.Characters.Latin_1.Quotation; 133 | elsif Quote_Char = Ada.Characters.Latin_1.Quotation then 134 | Quoted := False; 135 | end if; 136 | Append (Word, Next_Char); 137 | when Ada.Characters.Latin_1.Apostrophe => 138 | if not Quoted then 139 | Quoted := True; 140 | Quote_Char := Ada.Characters.Latin_1.Apostrophe; 141 | elsif Quote_Char = Ada.Characters.Latin_1.Apostrophe then 142 | Quoted := False; 143 | end if; 144 | Append (Word, Next_Char); 145 | -- Whitespace is only the end of the word if it's not 146 | -- escaped or in a quoted section. 147 | when Ada.Characters.Latin_1.Space | Ada.Characters.Latin_1.CR | Ada.Characters.Latin_1.HT | Ada.Characters.Latin_1.FF => 148 | -- Exit the loop here to keep Current pointing 149 | -- to the start of the whitespace. 150 | if Quoted then 151 | Append (Word, Next_Char); 152 | else 153 | exit; 154 | end if; 155 | when others => 156 | Append (Word, Next_Char); 157 | end case; 158 | end if; 159 | 160 | After_Last := After_Last + 1; 161 | end loop; 162 | 163 | pragma Assert (Length (Word) > 0); 164 | if SP.Strings.Is_Quoted (ASU.To_String (Word)) and then Length (Word) > 1 then 165 | Result.Words.Append (Unbounded_Slice (Word, 2, Length (Word) - 1)); 166 | else 167 | Result.Words.Append (Word); 168 | end if; 169 | end; 170 | end loop; 171 | 172 | return Result; 173 | end Make; 174 | 175 | function Common_Prefix_Length 176 | (A : Ada.Strings.Unbounded.Unbounded_String; B : Ada.Strings.Unbounded.Unbounded_String) return Natural is 177 | use Ada.Strings.Unbounded; 178 | -- Finds the number of common starting characters between two strings. 179 | begin 180 | return Count : Natural := 0 do 181 | while Count < Length (A) and then Count < Length (B) 182 | and then Element (A, Count + 1) = Element (B, Count + 1) loop 183 | Count := Count + 1; 184 | end loop; 185 | end return; 186 | end Common_Prefix_Length; 187 | 188 | function Matching_Suffix (Current, Desired : ASU.Unbounded_String) return ASU.Unbounded_String is 189 | Prefix_Length : constant Natural := SP.Strings.Common_Prefix_Length (Current, Desired); 190 | Suffix : constant ASU.Unbounded_String := ASU.Unbounded_Slice (Desired, Prefix_Length + 1, ASU.Length (Desired)); 191 | begin 192 | return Suffix; 193 | end Matching_Suffix; 194 | 195 | function Is_Quoted (S : String) return Boolean is 196 | use Ada.Characters.Latin_1; 197 | begin 198 | return S'Length >= 2 199 | and then S (S'First) in Quotation | Apostrophe 200 | and then S (S'First) = S (S'Last); 201 | end Is_Quoted; 202 | 203 | function Split_Command (Input : ASU.Unbounded_String) return SP.Strings.String_Vectors.Vector is 204 | Exploded : constant SP.Strings.Exploded_Line := SP.Strings.Make (ASU.To_String (Input)); 205 | 206 | begin 207 | return Result : SP.Strings.String_Vectors.Vector do 208 | for Word of Exploded.Words loop 209 | if SP.Strings.Is_Quoted (ASU.To_String (Word)) then 210 | Result.Append (ASU.Unbounded_Slice (Word, 2, ASU.Length (Word) - 1)); 211 | else 212 | Result.Append (Word); 213 | end if; 214 | end loop; 215 | end return; 216 | end Split_Command; 217 | 218 | function Get_Cursor_Word (E : SP.Strings.Exploded_Line; Cursor_Position : Positive) return Natural 219 | is 220 | Next : Natural := 1; 221 | Current_Cursor : Natural := 1; 222 | begin 223 | while Next <= Natural (E.Spacers.Length) loop 224 | Current_Cursor := Current_Cursor + ASU.To_String (E.Spacers (Next))'Length; 225 | 226 | if Next <= Positive (E.Words.Length) then 227 | Current_Cursor := Current_Cursor + ASU.To_String (E.Words (Next))'Length; 228 | end if; 229 | exit when Current_Cursor >= Cursor_Position; 230 | Next := Next + 1; 231 | end loop; 232 | return Next; 233 | end Get_Cursor_Word; 234 | 235 | function Cursor_Position_At_End_Of_Word (E : SP.Strings.Exploded_Line; Word : Positive) return Positive is 236 | begin 237 | return Cursor_Position : Positive := 1 do 238 | for I in 1 .. Word loop 239 | Cursor_Position := Cursor_Position + ASU.Length (E.Spacers (I)); 240 | Cursor_Position := Cursor_Position + ASU.Length (E.Words (I)); 241 | end loop; 242 | end return; 243 | end Cursor_Position_At_End_Of_Word; 244 | 245 | end SP.Strings; 246 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /src/common/sp-interactive.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | with Ada.Containers; 17 | with Ada.Strings.Fixed; 18 | with Ada.Strings.Unbounded; 19 | with Ada.Text_IO; 20 | with ANSI; 21 | with SP.Commands; 22 | with SP.Config; 23 | with SP.File_System; 24 | with SP.Filters; 25 | with SP.Searches; 26 | with SP.Strings; 27 | with SP.Terminal; 28 | with Trendy_Terminal.Environments; 29 | with Trendy_Terminal.Histories; 30 | with Trendy_Terminal.IO.Line_Editors; 31 | with Trendy_Terminal.Lines.Line_Vectors; 32 | with Trendy_Terminal.Platform; 33 | 34 | package body SP.Interactive is 35 | package ASU renames Ada.Strings.Unbounded; 36 | use SP.Terminal; 37 | 38 | procedure Write_Prompt (Srch : in SP.Searches.Search) is 39 | -- Writes the prompt and get ready to read user input. 40 | Filter_Names : constant Sp.Strings.String_Vectors.Vector := SP.Searches.List_Filter_Names (Srch); 41 | Default_Prompt : constant String := " > "; 42 | Extensions : constant SP.Strings.String_Vectors.Vector := SP.Searches.List_Extensions (Srch); 43 | Context_Width : constant Natural := SP.Searches.Get_Context_Width (Srch); 44 | Max_Results : constant Natural := SP.Searches.Get_Max_Results (Srch); 45 | Second_Col : constant := 30; 46 | begin 47 | New_Line; 48 | Put ("Files: " & SP.Searches.Num_Files (Srch)'Image); 49 | Set_Col (Second_Col); 50 | Put ("Extensions: "); 51 | if Extensions.Is_Empty then 52 | Put ("Any"); 53 | else 54 | Put ("(only) "); 55 | for Extension of Extensions loop 56 | Put (Extension); 57 | Put (" "); 58 | end loop; 59 | end if; 60 | New_Line; 61 | Put ("Distance: " & (if Context_Width = SP.Searches.No_Context_Width then "Any" else Context_Width'Image)); 62 | Set_Col (Second_Col); 63 | Put ("Max Results: " & (if Max_Results = SP.Searches.No_Max_Results then "Unlimited" else Max_Results'Image)); 64 | New_Line; 65 | 66 | Put ("Filters: "); 67 | if Integer (Filter_Names.Length) = 0 then 68 | Put ("None"); 69 | end if; 70 | New_Line; 71 | for Index in 1 .. SP.Strings.String_Vectors.Length (Filter_Names) loop 72 | Put (" " & Ada.Strings.Fixed.Trim (Index'Image, Ada.Strings.Left)); 73 | Set_Col (6); 74 | for Spacer in 1 .. Index loop 75 | Put (" "); 76 | end loop; 77 | Put_Line (Filter_Names.Element (Integer(Index))); 78 | end loop; 79 | 80 | New_Line; 81 | Put (Default_Prompt); 82 | end Write_Prompt; 83 | 84 | function Apply_Formatting (V : SP.Strings.String_Vectors.Vector) return SP.Strings.String_Vectors.Vector is 85 | Result : SP.Strings.String_Vectors.Vector; 86 | use all type ASU.Unbounded_String; 87 | begin 88 | for Index in 1 .. V.Length loop 89 | declare 90 | US : constant ASU.Unbounded_String := V ( Positive (Index)); 91 | S : constant String := ASU.To_String (US); 92 | use all type Ada.Containers.Count_Type; 93 | begin 94 | if Positive (Index) = 1 then 95 | if SP.Commands.Is_Command (S) or else (SP.Commands.Is_Like_Command (S) and then V.Length > 1) then 96 | Result.Append (SP.Terminal.Colorize(US, ANSI.Green)); 97 | elsif SP.Commands.Is_Like_Command (S) and then V.Length = 1 then 98 | declare 99 | Command : constant ASU.Unbounded_String := SP.Commands.Target_Command (US); 100 | Suffix : constant ASU.Unbounded_String := SP.Strings.Matching_Suffix (US, Command); 101 | begin 102 | Result.Append ( 103 | SP.Terminal.Colorize (US, ANSI.Yellow) 104 | & SP.Terminal.Colorize (Suffix, ANSI.Light_Cyan)); 105 | end; 106 | else 107 | Result.Append (SP.Terminal.Colorize (US, ANSI.Red)); 108 | end if; 109 | elsif SP.Commands.Target_Command (V (1)) = "find-regex" 110 | or else SP.Commands.Target_Command (V (1)) = "exclude-regex" 111 | then 112 | if SP.Filters.Is_Valid_Regex (S) then 113 | Result.Append (SP.Terminal.Colorize (US, ANSI.Green)); 114 | else 115 | Result.Append (SP.Terminal.Colorize (US, ANSI.Red)); 116 | end if; 117 | else 118 | if SP.File_System.Is_File (S) or else SP.File_System.Is_Dir (S) then 119 | Result.Append (SP.Terminal.Colorize (US, ANSI.Magenta)); 120 | else 121 | Result.Append (US); 122 | end if; 123 | end if; 124 | end; 125 | end loop; 126 | return Result; 127 | end Apply_Formatting; 128 | 129 | function Format_Input (L : Trendy_Terminal.Lines.Line) return Trendy_Terminal.Lines.Line is 130 | Exploded : constant SP.Strings.Exploded_Line := SP.Strings.Make (Trendy_Terminal.Lines.Current (L)); 131 | New_Line : constant String := ASU.To_String (SP.Strings.Zip (Exploded.Spacers, Apply_Formatting (Exploded.Words))); 132 | begin 133 | return Trendy_Terminal.Lines.Make (New_Line, New_Line'Length + 1); 134 | end Format_Input; 135 | 136 | -- Completion callback based on the number of history inputs. 137 | function Complete_Input (L : Trendy_Terminal.Lines.Line) 138 | return Trendy_Terminal.Lines.Line_Vectors.Vector 139 | is 140 | E : SP.Strings.Exploded_Line := SP.Strings.Make (Trendy_Terminal.Lines.Current (L)); 141 | Cursor_Word : constant Positive := SP.Strings.Get_Cursor_Word (E, Trendy_Terminal.Lines.Get_Cursor_Index (L)); 142 | Result : Trendy_Terminal.Lines.Line_Vectors.Vector; 143 | Completion : ASU.Unbounded_String; 144 | Suffix : ASU.Unbounded_String; 145 | use all type ASU.Unbounded_String; 146 | use SP.Strings.String_Vectors; 147 | use type Ada.Containers.Count_Type; 148 | begin 149 | if E.Words.Length < Ada.Containers.Count_Type (Cursor_Word) then 150 | return Result; 151 | end if; 152 | 153 | -- Find the position of the cursor within line. 154 | if Cursor_Word = 1 then 155 | if SP.Commands.Is_Like_Command (ASU.To_String (E.Words(1))) then 156 | Completion := SP.Commands.Target_Command (E.Words(1)); 157 | Suffix := SP.Strings.Matching_Suffix (E.Words (1), Completion); 158 | E.Words (1) := E.Words (1) & Suffix; 159 | Result.Append (Trendy_Terminal.Lines.Make (ASU.To_String (SP.Strings.Zip (E.Spacers, E.Words)), 160 | Trendy_Terminal.Lines.Get_Cursor_Index (L) + Trendy_Terminal.Lines.Num_Cursor_Positions (ASU.To_String (Suffix)))); 161 | return Result; 162 | end if; 163 | else 164 | declare 165 | Completions : SP.Strings.String_Vectors.Vector := SP.File_System.File_Completions (ASU.To_String (E.Words (Cursor_Word))); 166 | package String_Sorting is new SP.Strings.String_Vectors.Generic_Sorting; 167 | begin 168 | String_Sorting.Sort (Completions); 169 | for Completion of Completions loop 170 | E.Words (Cursor_Word) := Completion; 171 | Result.Append (Trendy_Terminal.Lines.Make (ASU.To_String (SP.Strings.Zip (E.Spacers, E.Words)), 172 | SP.Strings.Cursor_Position_At_End_Of_Word (E, Cursor_Word))); 173 | end loop; 174 | end; 175 | end if; 176 | 177 | if Result.Is_Empty then 178 | Result.Append (L); 179 | end if; 180 | 181 | return Result; 182 | end Complete_Input; 183 | 184 | function Read_Command (Line_History : aliased in out Trendy_Terminal.Histories.History) return ASU.Unbounded_String is 185 | Input : constant ASU.Unbounded_String := ASU.To_Unbounded_String( 186 | Trendy_Terminal.IO.Line_Editors.Get_Line ( 187 | Format_Fn => Format_Input'Access, 188 | Completion_Fn => Complete_Input'Access, 189 | Line_History => Line_History'Unchecked_Access 190 | )); 191 | begin 192 | -- Keep the input remaining on the line without clearing it. 193 | New_Line; 194 | 195 | return Input; 196 | end Read_Command; 197 | 198 | -- The interactive loop through which the user starts a search context and then interatively refines it by 199 | -- pushing and popping operations. 200 | procedure Main is 201 | Input : ASU.Unbounded_String; 202 | Command_Line : SP.Strings.String_Vectors.Vector; 203 | Srch : SP.Searches.Search; 204 | Configs : constant SP.Strings.String_Vectors.Vector := SP.Config.Config_Locations; 205 | Environment : Trendy_Terminal.Environments.Environment; 206 | Result : SP.Commands.Command_Result; 207 | Line_History : aliased Trendy_Terminal.Histories.History; 208 | begin 209 | if not Environment.Is_Available then 210 | Ada.Text_IO.Put_Line ("[ERROR] No support either for UTF-8 or VT100."); 211 | Ada.Text_IO.Put_Line ("[ERROR] Try another terminal."); 212 | return; 213 | end if; 214 | 215 | Trendy_Terminal.Platform.Set (Trendy_Terminal.Platform.Echo, False); 216 | Trendy_Terminal.Platform.Set (Trendy_Terminal.Platform.Line_Input, False); 217 | Trendy_Terminal.Platform.Set (Trendy_Terminal.Platform.Escape_Sequences, True); 218 | Trendy_Terminal.Platform.Set (Trendy_Terminal.Platform.Signals_As_Input, True); 219 | 220 | Set_Col(1); 221 | Put_Line ("septum v" & SP.Version); 222 | New_Line; 223 | 224 | for Config of Configs loop 225 | Result := SP.Commands.Run_Commands_From_File (Srch, ASU.To_String(Config)); 226 | case Result is 227 | when SP.Commands.Command_Success => null; 228 | when SP.Commands.Command_Failed => 229 | Put_Line ("Failing running commands from: " & ASU.To_String(Config)); 230 | return; 231 | when SP.Commands.Command_Unknown => 232 | Put_Line ("Unknown command in: " & ASU.To_String(Config)); 233 | when SP.Commands.Command_Exit_Requested => 234 | return; 235 | end case; 236 | end loop; 237 | 238 | loop 239 | Write_Prompt (Srch); 240 | Input := Read_Command (Line_History); 241 | Command_Line := SP.Strings.Split_Command (Input); 242 | 243 | if not Command_Line.Is_Empty then 244 | Result := SP.Commands.Execute (Srch, Command_Line); 245 | case Result is 246 | when SP.Commands.Command_Success => null; 247 | -- Add command to history 248 | Trendy_Terminal.Histories.Add (Line_History, ASU.To_String (Input)); 249 | when SP.Commands.Command_Failed => 250 | Put_Line ("Command failed"); 251 | when SP.Commands.Command_Unknown => 252 | Put_Line ("Unknown command"); 253 | when SP.Commands.Command_Exit_Requested => 254 | return; 255 | end case; 256 | end if; 257 | end loop; 258 | end Main; 259 | end SP.Interactive; 260 | -------------------------------------------------------------------------------- /src/common/sp-searches.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Directories; 18 | with Ada.Strings.Unbounded; 19 | with ANSI; 20 | with Atomic.Signed; 21 | 22 | with Progress_Indicators.Work_Trackers; 23 | 24 | with SP.Progress; 25 | with SP.Terminal; 26 | 27 | with System.Multiprocessors.Dispatching_Domains; 28 | 29 | package body SP.Searches is 30 | use Ada.Strings.Unbounded; 31 | use SP.Terminal; 32 | 33 | function Load_Directory (Srch : in out Search; Dir_Name : String) return Boolean is 34 | use Ada.Directories; 35 | Path_Exists : constant Boolean := Exists (Dir_Name); 36 | Is_Directory : constant Boolean := Path_Exists and then Kind (Dir_Name) = Directory; 37 | begin 38 | if Is_Directory then 39 | return SP.Cache.Add_Directory_Recursively (Srch.File_Cache, Dir_Name); 40 | else 41 | SP.Terminal.Put_Line ("Cannot cache " & Dir_Name & ". It is not a directory."); 42 | return False; 43 | end if; 44 | end Load_Directory; 45 | 46 | function Reload_Working_Set (Srch : in out Search) 47 | return Boolean is 48 | begin 49 | -- TODO: The file cache should watch files to know when it needs a refresh such as examining last time modified 50 | -- timestamp. 51 | Srch.File_Cache.Clear; 52 | for Dir_Name of Srch.Directories loop 53 | if not Load_Directory (Srch, To_String (Dir_Name)) then 54 | Put_Line ("Did not finish loading directory: " & To_String (Dir_Name)); 55 | return False; 56 | end if; 57 | end loop; 58 | return True; 59 | end Reload_Working_Set; 60 | 61 | function Add_Directory (Srch : in out Search; Dir_Name : String) return Boolean is 62 | use Ada.Directories; 63 | Unbounded_Name : constant Unbounded_String := To_Unbounded_String (Dir_Name); 64 | Path_Exists : constant Boolean := Exists (Dir_Name); 65 | Is_Directory : constant Boolean := Path_Exists and then Kind (Dir_Name) = Directory; 66 | begin 67 | -- TODO: this should also ensure new directories aren't subdirectories of existing directories 68 | if Is_Directory and then not Srch.Directories.Contains (Unbounded_Name) then 69 | Srch.Directories.Insert (Unbounded_Name); 70 | if Load_Directory (Srch, Dir_Name) then 71 | SP.Terminal.Put_Line ("Added " & Dir_Name & " to search path."); 72 | return True; 73 | else 74 | Put_Line ("Directory load cancelled."); 75 | return False; 76 | end if; 77 | else 78 | SP.Terminal.Put_Line ("Could not add " & Dir_Name & " to search path."); 79 | return True; 80 | end if; 81 | end Add_Directory; 82 | 83 | function List_Directories (Srch : in Search) return String_Vectors.Vector is 84 | begin 85 | return Result : String_Vectors.Vector do 86 | for Directory of Srch.Directories loop 87 | Result.Append (Directory); 88 | end loop; 89 | end return; 90 | end List_Directories; 91 | 92 | procedure Clear_Directories (Srch : in out Search) is 93 | begin 94 | Srch.Directories.Clear; 95 | Srch.File_Cache.Clear; 96 | end Clear_Directories; 97 | 98 | procedure Add_Extension (Srch : in out Search; Extension : String) is 99 | Ext : constant Unbounded_String := To_Unbounded_String (Extension); 100 | begin 101 | if not Srch.Extensions.Contains (Ext) then 102 | Srch.Extensions.Insert (Ext); 103 | end if; 104 | end Add_Extension; 105 | 106 | procedure Remove_Extension (Srch : in out Search; Extension : String) is 107 | Ext : constant Unbounded_String := To_Unbounded_String (Extension); 108 | begin 109 | if Srch.Extensions.Contains (Ext) then 110 | Srch.Extensions.Delete (Ext); 111 | end if; 112 | end Remove_Extension; 113 | 114 | procedure Clear_Extensions (Srch : in out Search) is 115 | begin 116 | Srch.Extensions.Clear; 117 | end Clear_Extensions; 118 | 119 | function List_Extensions (Srch : in Search) return String_Vectors.Vector is 120 | begin 121 | return Exts : String_Vectors.Vector do 122 | for Ext of Srch.Extensions loop 123 | Exts.Append (Ext); 124 | end loop; 125 | end return; 126 | end List_Extensions; 127 | 128 | procedure Find_Text (Srch : in out Search; Text : String) is 129 | begin 130 | Srch.Line_Filters.Append (Filters.Find_Text (Text)); 131 | end Find_Text; 132 | 133 | procedure Exclude_Text (Srch : in out Search; Text : String) is 134 | begin 135 | Srch.Line_Filters.Append (Filters.Exclude_Text (Text)); 136 | end Exclude_Text; 137 | 138 | procedure Find_Like (Srch : in out Search; Text : String) is 139 | begin 140 | Srch.Line_Filters.Append (Filters.Find_Like (Text)); 141 | end Find_Like; 142 | 143 | procedure Exclude_Like (Srch : in out Search; Text : String) is 144 | begin 145 | Srch.Line_Filters.Append (Filters.Exclude_Like (Text)); 146 | end Exclude_Like; 147 | 148 | procedure Find_Regex (Srch : in out Search; Text : String) is 149 | F : constant Filter_Ptr := Filters.Find_Regex (Text); 150 | begin 151 | if F.Is_Valid then 152 | Srch.Line_Filters.Append (F); 153 | end if; 154 | end Find_Regex; 155 | 156 | procedure Exclude_Regex (Srch : in out Search; Text : String) is 157 | F : constant Filter_Ptr := Filters.Exclude_Regex (Text); 158 | begin 159 | if F.Is_Valid then 160 | Srch.Line_Filters.Append (F); 161 | end if; 162 | end Exclude_Regex; 163 | 164 | procedure Drop_Filter (Srch : in out Search; Index : Positive) is 165 | Filter_Being_Dropped : constant Filter_Ptr := 166 | (if Natural (Index) > Natural (Srch.Line_Filters.Length) 167 | then Pointers.Make_Null else Srch.Line_Filters.Element (Index)); 168 | begin 169 | if not Filter_Being_Dropped.Is_Valid then 170 | SP.Terminal.Put_Line ("No filter exists at that index to drop."); 171 | else 172 | SP.Terminal.Put_Line ("Dropping filter: " & Image (Filter_Being_Dropped.Get)); 173 | Srch.Line_Filters.Delete (Index); 174 | end if; 175 | end Drop_Filter; 176 | 177 | procedure Pop_Filter (Srch : in out Search) is 178 | begin 179 | if Srch.Line_Filters.Is_Empty then 180 | SP.Terminal.Put_line ("There are no filters to pop."); 181 | else 182 | Drop_Filter (Srch, Positive (Srch.Line_Filters.Length)); 183 | end if; 184 | end Pop_Filter; 185 | 186 | procedure Reorder_Filters (Srch : in out Search; Indices : Positive_Vectors.Vector) is 187 | New_Filters : Filter_List.Vector := Filter_List.Empty_Vector; 188 | begin 189 | for Index of Indices loop 190 | New_Filters.Append (Srch.Line_Filters.Element (Index)); 191 | end loop; 192 | Srch.Line_Filters.Move (New_Filters); 193 | pragma Unreferenced (New_Filters); 194 | end Reorder_Filters; 195 | 196 | procedure Clear_Filters (Srch : in out Search) is 197 | begin 198 | Srch.Line_Filters.Clear; 199 | end Clear_Filters; 200 | 201 | procedure Set_Context_Width (Srch : in out Search; Context_Width : Natural) is 202 | begin 203 | Srch.Context_Width := Context_Width; 204 | end Set_Context_Width; 205 | 206 | function Get_Context_Width (Srch : in Search) return Natural is (Srch.Context_Width); 207 | 208 | procedure Set_Max_Results (Srch : in out Search; Max_Results : Natural) is 209 | begin 210 | Srch.Max_Results := Max_Results; 211 | end Set_Max_Results; 212 | 213 | function Get_Max_Results (Srch : in Search) return Natural is (Srch.Max_Results); 214 | 215 | procedure Set_Search_On_Filters_Changed (Srch : in out Search; Enabled : Boolean) is 216 | begin 217 | Srch.Search_On_Filters_Changed := Enabled; 218 | end Set_Search_On_Filters_Changed; 219 | 220 | function Get_Search_On_Filters_Changed (Srch : in out Search) return Boolean is (Srch.Search_On_Filters_Changed); 221 | 222 | procedure Set_Line_Colors_Enabled (Srch : in out Search; Enabled : Boolean) is 223 | begin 224 | Srch.Enable_Line_Colors := Enabled; 225 | end Set_Line_Colors_Enabled; 226 | 227 | procedure Set_Print_Line_Numbers (Srch : in out Search; Enabled : Boolean) is 228 | begin 229 | Srch.Print_Line_Numbers := Enabled; 230 | end Set_Print_Line_Numbers; 231 | 232 | function Get_Print_Line_Numbers (Srch : in Search) return Boolean is (Srch.Print_Line_Numbers); 233 | 234 | function List_Filter_Names (Srch : Search) return String_Vectors.Vector is 235 | begin 236 | return V : String_Vectors.Vector do 237 | for F of Srch.Line_Filters loop 238 | V.Append (To_Unbounded_String (F.Get.Action'Image & " : " & Image (F.Get))); 239 | end loop; 240 | end return; 241 | end List_Filter_Names; 242 | 243 | function Num_Filters (Srch : Search) return Natural is (Integer (Srch.Line_Filters.Length)); 244 | 245 | function Matching_Contexts 246 | (File_Name : String; Num_Lines : Natural; Lines : SP.Contexts.Line_Matches.Set; Context_Width : Natural) 247 | return SP.Contexts.Context_Vectors.Vector is 248 | begin 249 | return C : SP.Contexts.Context_Vectors.Vector do 250 | for Line of Lines loop 251 | C.Append (SP.Contexts.From (File_Name, Line, Num_Lines, Context_Width)); 252 | end loop; 253 | end return; 254 | end Matching_Contexts; 255 | 256 | procedure Matching_Contexts_In_File 257 | -- TODO: This code is a horrible mess and needs to be split up. 258 | (Srch : in Search; File : in Unbounded_String; Concurrent_Results : in out Concurrent_Context_Results) is 259 | Excluded_Lines : SP.Contexts.Line_Matches.Set; 260 | First_Pass : Boolean := True; -- The first filter pass has nothing to merge into. 261 | Lines : SP.Contexts.Line_Matches.Set; 262 | Last : SP.Contexts.Context_Vectors.Vector; 263 | Next : SP.Contexts.Context_Vectors.Vector; 264 | Merged : SP.Contexts.Context_Vectors.Vector; 265 | Result : SP.Contexts.Context_Vectors.Vector; 266 | begin 267 | -- Process the file using the given filters. 268 | for F of Srch.Line_Filters loop 269 | Lines := SP.Filters.Matching_Lines (F.Get, Srch.File_Cache.Lines (File)); 270 | 271 | case F.Get.Action is 272 | -- No context should contain an excluded line. This could be more granular by finding contexts smaller 273 | -- than the given context width with no matching terms outside of the excluded terms. 274 | when Exclude => 275 | Excluded_Lines.Union (Lines); 276 | when Keep => 277 | Next := 278 | Matching_Contexts 279 | (To_String (File), Natural (Srch.File_Cache.Lines (File).Length), Lines, 280 | Srch.Context_Width); 281 | 282 | -- First pass has nothing to merge onto. 283 | if First_Pass then 284 | First_Pass := False; 285 | Merged := Next; 286 | else 287 | Last := Merged; 288 | Merged.Clear; 289 | for L of Last loop 290 | for N of Next loop 291 | if SP.Contexts.Overlap (L, N) then 292 | Merged.Append (SP.Contexts.Merge (L, N)); 293 | end if; 294 | end loop; 295 | end loop; 296 | end if; 297 | end case; 298 | end loop; 299 | 300 | declare 301 | All_Matches_In_Contexts : SP.Contexts.Line_Matches.Set; 302 | Matching_Contexts : SP.Contexts.Context_Vectors.Vector; 303 | begin 304 | -- Matching contexts of overlapping terms have been merged into single contexts. Remove those contexts with 305 | -- excluded lines to get the final result for this file. 306 | for G of Merged loop 307 | declare 308 | Cut : Boolean := False; 309 | begin 310 | -- Matching contexts cannot contain any excluded lines. 311 | for A of Excluded_Lines loop 312 | if SP.Contexts.Contains (G, A) then 313 | Cut := True; 314 | exit; 315 | end if; 316 | end loop; 317 | 318 | if not Cut then 319 | All_Matches_In_Contexts.Union (G.Internal_Matches); 320 | Matching_Contexts.Append (G); 321 | end if; 322 | end; 323 | end loop; 324 | 325 | -- Merge down 326 | for C of Matching_Contexts loop 327 | declare 328 | Duplicate : Boolean := False; 329 | use type SP.Contexts.Context_Match; 330 | begin 331 | for D of Matching_Contexts loop 332 | if C /= D and then SP.Contexts.Contains(D, C) then 333 | Duplicate := True; 334 | exit; 335 | end if; 336 | end loop; 337 | 338 | if not Duplicate then 339 | -- It's nice to have the lines which contain a match to be marked as such. 340 | for M of All_Matches_In_Contexts loop 341 | if SP.Contexts.Contains (C, M) and then not C.Internal_Matches.Contains (M) then 342 | C.Internal_Matches.Insert (M); 343 | end if; 344 | end loop; 345 | Result.Append (C); 346 | end if; 347 | end; 348 | end loop; 349 | end; 350 | Concurrent_Results.Add_Result (Result); 351 | end Matching_Contexts_In_File; 352 | 353 | function Files_To_Search (Srch : in Search) return String_Vectors.Vector is 354 | begin 355 | return Result : String_Vectors.Vector do 356 | if Srch.Extensions.Is_Empty then 357 | Result := Srch.File_Cache.Files; 358 | return; 359 | end if; 360 | 361 | for File of Srch.File_Cache.Files loop 362 | declare 363 | Extension : constant String := Ada.Directories.Extension (To_String(File)); 364 | begin 365 | if Srch.Extensions.Contains (To_Unbounded_String(Extension)) then 366 | Result.Append (File); 367 | end if; 368 | end; 369 | end loop; 370 | end return; 371 | end Files_To_Search; 372 | 373 | function Matching_Contexts (Srch : in Search) return SP.Contexts.Context_Vectors.Vector is 374 | package Atomic_Int is new Atomic.Signed (T => Integer); 375 | 376 | Files : constant String_Vectors.Vector := Files_To_Search (Srch); 377 | Merged_Results : Concurrent_Context_Results; 378 | Next_File : aliased Atomic_Int.Instance := Atomic_Int.Init (1); 379 | Next_Access : constant access Atomic_Int.Instance := Next_File'Access; 380 | Work : aliased Progress_Indicators.Work_Trackers.Work_Tracker; 381 | 382 | task type Matching_Context_Search is 383 | entry Start; 384 | end Matching_Context_Search; 385 | 386 | task body Matching_Context_Search is 387 | Next_Index : Natural; 388 | Next_File : Unbounded_String; 389 | begin 390 | accept Start; 391 | loop 392 | Next_Index := Natural (Atomic_Int.Fetch_Add (Next_Access.all, 1)); 393 | if Next_Index <= Natural (Files.Length) then 394 | Next_File := Files (Next_Index); 395 | Matching_Contexts_In_File (Srch, Next_File, Merged_Results); 396 | else 397 | exit; 398 | end if; 399 | Work.Finish_Work (1); 400 | end loop; 401 | end Matching_Context_Search; 402 | 403 | package MP renames System.Multiprocessors; 404 | use all type MP.CPU_Range; 405 | Progress_Tracker : SP.Progress.Update_Progress (Work'Access); 406 | Num_Tasks : constant MP.CPU := MP.Number_Of_CPUs; 407 | Result : SP.Contexts.Context_Vectors.Vector; 408 | begin 409 | declare 410 | All_Searches : array (0 .. Num_Tasks - 1) of Matching_Context_Search; 411 | begin 412 | Work.Start_Work (Integer (Files.Length)); 413 | Merged_Results.Wait_For (Natural (Files.Length)); 414 | for I in All_Searches'Range loop 415 | begin 416 | MP.Dispatching_Domains.Set_CPU (I, All_Searches (I)'Identity); 417 | exception 418 | when MP.Dispatching_Domains.Dispatching_Domain_Error => null; 419 | end; 420 | All_Searches (I).Start; 421 | end loop; 422 | Merged_Results.Get_Results (Result); 423 | Progress_Tracker.Stop; 424 | end; 425 | return Result; 426 | end Matching_Contexts; 427 | 428 | procedure Print_Context (Srch : SP.Searches.Search; Context : SP.Contexts.Context_Match) is 429 | begin 430 | Put_Line (SP.Terminal.Colorize (To_String (Context.File_Name), ANSI.Light_Magenta)); 431 | for Line_Num in Context.Minimum .. Context.Maximum loop 432 | if Context.Internal_Matches.Contains (Line_Num) then 433 | Put ("-> "); 434 | else 435 | Put (" "); 436 | end if; 437 | if Srch.Print_Line_Numbers then 438 | declare 439 | Max_Line_Name_Width : constant := 6; 440 | Line : constant String := Line_Num'Image; 441 | Spaces : constant String (1 .. Max_Line_Name_Width - Line'Length) := (others => ' '); 442 | begin 443 | if Spaces'Length > 0 then 444 | Put (Spaces); 445 | end if; 446 | Put (Line); 447 | end; 448 | Put (" "); 449 | end if; 450 | if Srch.Enable_Line_Colors and then Context.Internal_Matches.Contains (Line_Num) then 451 | Put_Line (SP.Terminal.Colorize ( 452 | To_String (Srch.File_Cache.File_Line (Context.File_Name, Line_Num)), 453 | ANSI.Green)); 454 | else 455 | Put_Line (To_String (Srch.File_Cache.File_Line (Context.File_Name, Line_Num))); 456 | end if; 457 | end loop; 458 | New_Line; 459 | end Print_Context; 460 | 461 | procedure Print_Contexts ( 462 | Srch : in Search; 463 | Contexts : SP.Contexts.Context_Vectors.Vector; 464 | First : Natural; 465 | Last : Natural 466 | ) is 467 | -- Max_Results : constant Natural := Srch.Max_Results; 468 | -- Num_Results_Printed : Natural := 0; 469 | begin 470 | if Natural (Contexts.Length) > Last - First + 1 and then First = 1 and then Last = No_Limit then 471 | Put_Line ("Found" & Contexts.Length'Image & " results."); 472 | else 473 | for Index in First .. Natural'Min (Last, Natural (Contexts.Length)) loop 474 | New_Line; 475 | Print_Context (Srch, Contexts (Index)); 476 | end loop; 477 | New_Line; 478 | end if; 479 | Put_Line ("Matching contexts: " & Contexts.Length'Image); 480 | Put_Line ("Matching files:" & SP.Contexts.Files_In (Contexts).Length'Image); 481 | end Print_Contexts; 482 | 483 | procedure Print_Contexts_With_Cancellation( 484 | Srch : in Search; 485 | Contexts : SP.Contexts.Context_Vectors.Vector; 486 | First : Natural; 487 | Last : Natural) 488 | is 489 | begin 490 | Print_Contexts (Srch, Contexts, First, Last); 491 | end Print_Contexts_With_Cancellation; 492 | 493 | function Num_Files (Srch : in Search) return Natural is 494 | begin 495 | return Srch.File_Cache.Num_Files; 496 | end Num_Files; 497 | 498 | function Num_Lines (Srch : in Search) return Natural is 499 | begin 500 | return Srch.File_Cache.Num_Lines; 501 | end Num_Lines; 502 | 503 | protected body Concurrent_Context_Results is 504 | entry Get_Results (Out_Results : out SP.Contexts.Context_Vectors.Vector) when Pending_Results = 0 is 505 | begin 506 | Out_Results := Results; 507 | end Get_Results; 508 | 509 | procedure Wait_For (Num_Results : Natural) is 510 | begin 511 | Pending_Results := Num_Results; 512 | end Wait_For; 513 | 514 | procedure Add_Result (More : SP.Contexts.Context_Vectors.Vector) is 515 | begin 516 | Results.Append (More); 517 | Pending_Results := Pending_Results - 1; 518 | end Add_Result; 519 | end Concurrent_Context_Results; 520 | 521 | 522 | function Is_Running_Script (Srch : Search; Script_Path : String) return Boolean 523 | is (Srch.Script_Stack.Contains (ASU.To_Unbounded_String (Script_Path))); 524 | 525 | procedure Push_Script (Srch : in out Search; Script_Path : String) is 526 | begin 527 | Srch.Script_Stack.Insert (ASU.To_Unbounded_String (Script_Path)); 528 | end Push_Script; 529 | 530 | procedure Pop_Script (Srch : in out Search; Script_Path : String) is 531 | begin 532 | Srch.Script_Stack.Delete (ASU.To_Unbounded_String (Script_Path)); 533 | end Pop_Script; 534 | 535 | procedure Test (Srch : Search; Input : String) is 536 | Keeps : Natural := 0; 537 | Excludes : Natural := 0; 538 | begin 539 | for F of Srch.Line_Filters loop 540 | Put ('['); 541 | if F.Get.Matches_Line (Input) then 542 | case F.Get.Action is 543 | when SP.Filters.Keep => 544 | Put (SP.Terminal.Colorize (" MATCH ", ANSI.Light_Green)); 545 | Keeps := Keeps + 1; 546 | when SP.Filters.Exclude => 547 | Put (SP.Terminal.Colorize (" EXCLUDE ", ANSI.Light_Red)); 548 | Excludes := Excludes + 1; 549 | end case; 550 | else 551 | Put (" "); 552 | end if; 553 | Put ("] "); 554 | Put (F.Get.Image); 555 | New_Line; 556 | end loop; 557 | 558 | -- Summary 559 | New_Line; 560 | if Excludes > 0 then 561 | Put (SP.Terminal.Colorize ("EXCLUDED", ANSI.Light_Red)); 562 | elsif Keeps > 0 then 563 | Put (SP.Terminal.Colorize ("MATCHED", ANSI.Light_Green)); 564 | else 565 | Put ("IGNORED"); 566 | end if; 567 | New_Line; 568 | end Test; 569 | 570 | end SP.Searches; 571 | -------------------------------------------------------------------------------- /src/common/sp-commands.adb: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- Copyright 2021, The Septum Developers (see AUTHORS file) 3 | 4 | -- Licensed under the Apache License, Version 2.0 (the "License"); 5 | -- you may not use this file except in compliance with the License. 6 | -- You may obtain a copy of the License at 7 | 8 | -- http://www.apache.org/licenses/LICENSE-2.0 9 | 10 | -- Unless required by applicable law or agreed to in writing, software 11 | -- distributed under the License is distributed on an "AS IS" BASIS, 12 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | -- See the License for the specific language governing permissions and 14 | -- limitations under the License. 15 | ------------------------------------------------------------------------------- 16 | 17 | with Ada.Containers.Ordered_Maps; 18 | with Ada.Directories; 19 | with SP.Config; 20 | with SP.Contexts; 21 | with SP.File_System; 22 | with SP.Terminal; 23 | 24 | package body SP.Commands is 25 | pragma Assertion_Policy (Pre => Check, Post => Check); 26 | 27 | use Ada.Strings.Unbounded; 28 | use SP.Terminal; 29 | 30 | type Help_Proc is not null access procedure; 31 | -- Prints a detailed help description for a command. 32 | 33 | type Exec_Proc is not null access function 34 | (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) 35 | return Command_Result; 36 | -- Executes a command. 37 | 38 | type Executable_Command is record 39 | Simple_Help : Unbounded_String; 40 | -- A brief help description. 41 | 42 | Help : Help_Proc; 43 | -- Prints a much longer help description. 44 | 45 | Exec : Exec_Proc; 46 | -- Executes the command. 47 | end record; 48 | 49 | package Command_Maps is new Ada.Containers.Ordered_Maps 50 | (Key_Type => Unbounded_String, Element_Type => Executable_Command); 51 | 52 | -- The command map is split between a the procedure to execute, and also a 53 | -- command to print help information. 54 | Command_Map : Command_Maps.Map; 55 | 56 | function Is_Command (S : String) return Boolean is (Command_Map.Contains (To_Unbounded_String (S))); 57 | 58 | function Target_Command (Command_Name : Unbounded_String) return Unbounded_String 59 | is 60 | Best_Match : Unbounded_String := Null_Unbounded_String; 61 | Best_Match_Size : Natural := 0; 62 | Next_Match : Unbounded_String; 63 | Next_Match_Size : Natural := 0; 64 | Ambiguous : Boolean := False; 65 | begin 66 | if Command_Map.Contains (Command_Name) then 67 | return Command_Name; 68 | end if; 69 | 70 | for Cursor in Command_Map.Iterate loop 71 | Next_Match := Command_Maps.Key (Cursor); 72 | Next_Match_Size := Common_Prefix_Length (Next_Match, Command_Name); 73 | if Next_Match_Size = Length(Command_Name) then 74 | if Next_Match_Size = Best_Match_Size then 75 | -- Two things with the same prefix, the prefix is ambiguous. 76 | Best_Match := Null_Unbounded_String; 77 | Ambiguous := True; 78 | elsif Next_Match_Size > Best_Match_Size then 79 | Best_Match_Size := Next_Match_Size; 80 | Best_Match := Next_Match; 81 | Ambiguous := False; 82 | end if; 83 | end if; 84 | end loop; 85 | 86 | return (if Ambiguous then Null_Unbounded_String else Best_Match); 87 | end Target_Command; 88 | 89 | function Is_Like_Command (S : String) return Boolean is (Target_Command (To_Unbounded_String (S)) /= Null_Unbounded_String); 90 | 91 | function Try_Parse (Str : String; Value : in out Positive) return Boolean is 92 | begin 93 | Value := Positive'Value (Str); 94 | return True; 95 | exception 96 | when Constraint_Error => 97 | return False; 98 | end Try_Parse; 99 | 100 | function Execute (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 101 | Command_Name : constant Unbounded_String := 102 | (if Command_Line.Is_Empty then To_Unbounded_String ("") else Command_Line.First_Element); 103 | Best_Command : constant Unbounded_String := Target_Command (Command_Name); 104 | begin 105 | if Command_Map.Contains (Best_Command) then 106 | declare 107 | It : constant Command_Maps.Cursor := Command_Map.Find (Best_Command); 108 | Command : constant Executable_Command := Command_Maps.Element (It); 109 | Parameters : String_Vectors.Vector := Command_Line; 110 | begin 111 | Parameters.Delete_First; 112 | if Best_Command /= Command_Name then 113 | Put_Line ("Resolved to: " & To_String (Best_Command)); 114 | end if; 115 | New_Line; 116 | return Command.Exec.all (Srch, Parameters); 117 | end; 118 | end if; 119 | return Command_Unknown; 120 | end Execute; 121 | 122 | function Run_Commands_From_File (Srch : in out SP.Searches.Search; File : String) return Command_Result is 123 | Commands : SP.Strings.String_Vectors.Vector; 124 | function "+" (S : String) return ASU.Unbounded_String renames ASU.To_Unbounded_String; 125 | begin 126 | if not Ada.Directories.Exists (File) then 127 | Put_Line ("No config to read at: " & Ada.Directories.Full_Name (File)); 128 | return Command_Failed; 129 | end if; 130 | 131 | Put_Line ("Loading commands from: " & Ada.Directories.Full_Name (File)); 132 | 133 | if not SP.File_System.Read_Lines (Ada.Directories.Full_Name (File), Commands) then 134 | Put_Line ("Unable to load configuration file from: " & Ada.Directories.Full_Name (File)); 135 | end if; 136 | 137 | for Command of Commands loop 138 | declare 139 | Exploded : constant SP.Strings.Exploded_Line := SP.Strings.Make (To_String (Command)); 140 | Command_Line : constant String_Vectors.Vector := Exploded.Words; 141 | Result : Command_Result; 142 | begin 143 | New_Line; 144 | Put_Line (+" > " & Command); 145 | Result := SP.Commands.Execute (Srch, Command_Line); 146 | 147 | case Result is 148 | when Command_Success => null; 149 | when Command_Failed => 150 | Put_Line (+"Command failed: " & Command); 151 | return Command_Failed; 152 | when Command_Unknown => 153 | Put_Line (+"Unable to execute: " & Command); 154 | return Command_Unknown; 155 | when Command_Exit_Requested => 156 | return Command_Exit_Requested; 157 | end case; 158 | end; 159 | end loop; 160 | 161 | return Command_Success; 162 | end Run_Commands_From_File; 163 | 164 | ---------------------------------------------------------------------------- 165 | 166 | procedure Search_Updated (Srch : in out SP.Searches.Search) is 167 | use SP.Searches; 168 | Contexts : SP.Contexts.Context_Vectors.Vector; 169 | begin 170 | if Get_Search_On_Filters_Changed (Srch) then 171 | Contexts := Matching_Contexts (Srch); 172 | Print_Contexts (Srch, Contexts, 1, Get_Max_Results (Srch)); 173 | end if; 174 | end Search_Updated; 175 | 176 | ---------------------------------------------------------------------------- 177 | 178 | procedure Help_Help is 179 | use Command_Maps; 180 | begin 181 | Put_Line ("Septum is an interactive search tool for code discovery."); 182 | New_Line; 183 | 184 | Put_Line ("Searches occur across multi-line 'contexts'. Specify what"); 185 | Put_Line ("those must include with 'find' commands, and skip contexts"); 186 | Put_Line ("containing elements with 'exclude' commands."); 187 | New_Line; 188 | 189 | Put_Line ("Configurations are loaded from " & SP.Config.Config_Dir_Name & " directories,"); 190 | Put_Line ("in the user's home directory and the current directory when Septum is started."); 191 | Put_Line ("Commands will be executed from the " & SP.Config.Config_File_Name & " files in these on startup."); 192 | New_Line; 193 | 194 | -- Print commands. 195 | for Cursor in Command_Map.Iterate loop 196 | Put (" " & Key (Cursor)); 197 | Set_Col (30); 198 | Put_Line (Element (Cursor).Simple_Help); 199 | end loop; 200 | end Help_Help; 201 | 202 | function Help_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 203 | Command : constant Unbounded_String := 204 | (if Command_Line.Is_Empty then Null_Unbounded_String else Command_Line.First_Element); 205 | Target : constant Unbounded_String := Target_Command (Command); 206 | use Command_Maps; 207 | begin 208 | pragma Unreferenced (Srch); 209 | 210 | case Command_Line.Length is 211 | when 0 => 212 | Help_Help; 213 | when 1 => 214 | if Command_Map.Contains (Target) then 215 | declare 216 | Cursor : constant Command_Maps.Cursor := Command_Map.Find (Target); 217 | Command : constant Executable_Command := Command_Maps.Element (Cursor); 218 | begin 219 | Command.Help.all; 220 | end; 221 | end if; 222 | when others => 223 | Put_Line ("Unknown command"); 224 | end case; 225 | return Command_Success; 226 | end Help_Exec; 227 | 228 | ---------------------------------------------------------------------------- 229 | 230 | procedure Reload_Help is 231 | begin 232 | Put_Line ("Reload help"); 233 | end Reload_Help; 234 | 235 | function Reload_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 236 | begin 237 | if not Command_Line.Is_Empty then 238 | Put_Line ("Refresh should have an empty command line."); 239 | return Command_Failed; 240 | end if; 241 | if not SP.Searches.Reload_Working_Set (Srch) then 242 | Put_Line ("Aborted reload."); 243 | end if; 244 | return Command_Success; 245 | end Reload_Exec; 246 | 247 | ---------------------------------------------------------------------------- 248 | 249 | procedure Stats_Help is 250 | begin 251 | Put_Line ("Prints statistics about the file cache."); 252 | end Stats_Help; 253 | 254 | function Stats_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 255 | begin 256 | if not Command_Line.Is_Empty then 257 | Put_Line ("Stats should have an empty command line."); 258 | return Command_Failed; 259 | end if; 260 | Put_Line ("Files: " & SP.Searches.Num_Files (Srch)'Image); 261 | Put_Line ("Lines: " & SP.Searches.Num_Lines (Srch)'Image); 262 | return Command_Success; 263 | end Stats_Exec; 264 | 265 | ---------------------------------------------------------------------------- 266 | 267 | procedure Source_Help is 268 | begin 269 | Put_Line ("Loads and runs commands from a file."); 270 | end Source_Help; 271 | 272 | function Source_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 273 | begin 274 | if Command_Line.Is_Empty then 275 | Put_Line ("Must provide one or more config files to run."); 276 | return Command_Failed; 277 | end if; 278 | 279 | for File of Command_Line loop 280 | declare 281 | Result : Command_Result; 282 | begin 283 | if SP.Searches.Is_Running_Script (Srch, ASU.To_String (File)) then 284 | Put_Line ("Script file being sourced is being sourced again."); 285 | return Command_Failed; 286 | end if; 287 | 288 | SP.Searches.Push_Script (Srch, ASU.To_String (File)); 289 | Result := Run_Commands_From_File (Srch, ASU.To_String (File)); 290 | if Result /= Command_Success then 291 | SP.Searches.Pop_Script (Srch, ASU.To_String (File)); 292 | return Result; 293 | end if; 294 | SP.Searches.Pop_Script (Srch, ASU.To_String (File)); 295 | 296 | exception 297 | when others => 298 | Put_Line ("Unknown exception"); 299 | SP.Searches.Pop_Script (Srch, ASU.To_String (File)); 300 | end; 301 | end loop; 302 | 303 | return Command_Success; 304 | end Source_Exec; 305 | 306 | ---------------------------------------------------------------------------- 307 | 308 | procedure Test_Help is 309 | begin 310 | Put_Line ("Tests arguments against all filters."); 311 | end Test_Help; 312 | 313 | function Test_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 314 | begin 315 | if Command_Line.Is_Empty then 316 | Put_Line ("No filters to test."); 317 | return Command_Failed; 318 | end if; 319 | 320 | for Input of Command_Line loop 321 | Put_Line (Input); 322 | 323 | SP.Searches.Test (Srch, ASU.To_String (Input)); 324 | 325 | New_Line; 326 | end loop; 327 | 328 | return Command_Success; 329 | end Test_Exec; 330 | 331 | ---------------------------------------------------------------------------- 332 | 333 | procedure Add_Dirs_Help is 334 | begin 335 | Put_Line ("Adds a directory to the search list."); 336 | end Add_Dirs_Help; 337 | 338 | function Add_Dirs_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 339 | begin 340 | if Command_Line.Is_Empty then 341 | Put_Line ("Must provide directories to add to the search path."); 342 | return Command_Failed; 343 | end if; 344 | 345 | for Directory of Command_Line loop 346 | if not SP.Searches.Add_Directory (Srch, To_String (Directory)) then 347 | Put_Line ("Directory load aborted."); 348 | end if; 349 | end loop; 350 | return Command_Success; 351 | end Add_Dirs_Exec; 352 | 353 | ---------------------------------------------------------------------------- 354 | 355 | procedure List_Dirs_Help is 356 | begin 357 | Put_Line ("List the directories of the search list."); 358 | end List_Dirs_Help; 359 | 360 | function List_Dirs_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 361 | begin 362 | if not Command_Line.Is_Empty then 363 | Put_Line ("No arguments are allowed for directory listing."); 364 | return Command_Failed; 365 | end if; 366 | for Directory of SP.Searches.List_Directories (Srch) loop 367 | Put_Line (To_String (Directory)); 368 | end loop; 369 | return Command_Success; 370 | end List_Dirs_Exec; 371 | 372 | ---------------------------------------------------------------------------- 373 | 374 | procedure Clear_Dirs_Help is 375 | begin 376 | Put_Line ("Clears all search directories."); 377 | end Clear_Dirs_Help; 378 | 379 | function Clear_Dirs_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 380 | begin 381 | if not Command_Line.Is_Empty then 382 | Put_Line ("No arguments are allowed for clearing directories."); 383 | return Command_Failed; 384 | end if; 385 | SP.Searches.Clear_Directories (Srch); 386 | return Command_Success; 387 | end Clear_Dirs_Exec; 388 | 389 | ---------------------------------------------------------------------------- 390 | 391 | procedure Add_Extensions_Help is 392 | begin 393 | Put_Line ("Adds extension to the search list."); 394 | end Add_Extensions_Help; 395 | 396 | function Add_Extensions_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 397 | begin 398 | if Command_Line.Is_Empty then 399 | Put_Line ("Must provide extensions to filter."); 400 | return Command_Failed; 401 | end if; 402 | 403 | for Extension of Command_Line loop 404 | SP.Searches.Add_Extension (Srch, To_String (Extension)); 405 | end loop; 406 | return Command_Success; 407 | end Add_Extensions_Exec; 408 | 409 | ---------------------------------------------------------------------------- 410 | 411 | procedure Clear_Extensions_Help is 412 | begin 413 | Put_Line ("Clears extension to the search list."); 414 | end Clear_Extensions_Help; 415 | 416 | function Clear_Extensions_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 417 | begin 418 | if not Command_Line.Is_Empty then 419 | Put_Line ("No arguments allowed for clearing extension filtering."); 420 | return Command_Failed; 421 | end if; 422 | 423 | SP.Searches.Clear_Extensions (Srch); 424 | return Command_Success; 425 | end Clear_Extensions_Exec; 426 | 427 | ---------------------------------------------------------------------------- 428 | 429 | procedure Remove_Extensions_Help is 430 | begin 431 | Put_Line ("Removes extension to the search list."); 432 | end Remove_Extensions_Help; 433 | 434 | function Remove_Extensions_Exec (Srch : in out SP.Searches.Search; Command_Line : String_Vectors.Vector) return Command_Result is 435 | begin 436 | if Command_Line.Is_Empty then 437 | Put_Line ("Must provide extensions to remove from the filter."); 438 | return Command_Failed; 439 | end if; 440 | 441 | for Extension of Command_Line loop 442 | SP.Searches.Remove_Extension (Srch, To_String (Extension)); 443 | end loop; 444 | return Command_Success; 445 | end Remove_Extensions_Exec; 446 | 447 | ---------------------------------------------------------------------------- 448 | 449 | procedure List_Extensions_Help is 450 | begin 451 | Put_Line ("Lists extensions to filter by."); 452 | end List_Extensions_Help; 453 | 454 | function List_Extensions_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 455 | Extensions : constant String_Vectors.Vector := SP.Searches.List_Extensions (Srch); 456 | begin 457 | pragma Unreferenced (Command_Line); 458 | for Ext of Extensions loop 459 | Put_Line (To_String (Ext)); 460 | end loop; 461 | return Command_Success; 462 | end List_Extensions_Exec; 463 | 464 | ---------------------------------------------------------------------------- 465 | 466 | procedure Find_Text_Help is 467 | begin 468 | Put_Line ("Provides text to search for."); 469 | end Find_Text_Help; 470 | 471 | function Find_Text_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 472 | begin 473 | for Word of Command_Line loop 474 | SP.Searches.Find_Text (Srch, To_String (Word)); 475 | end loop; 476 | 477 | Search_Updated (Srch); 478 | return Command_Success; 479 | end Find_Text_Exec; 480 | 481 | ---------------------------------------------------------------------------- 482 | 483 | procedure Exclude_Text_Help is 484 | begin 485 | Put_Line ("Provides text to search for."); 486 | end Exclude_Text_Help; 487 | 488 | function Exclude_Text_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 489 | begin 490 | for Word of Command_Line loop 491 | SP.Searches.Exclude_Text (Srch, To_String (Word)); 492 | end loop; 493 | 494 | Search_Updated (Srch); 495 | return Command_Success; 496 | end Exclude_Text_Exec; 497 | 498 | ---------------------------------------------------------------------------- 499 | 500 | procedure Find_Like_Help is 501 | begin 502 | Put_Line ("Provides text to search for (case insensitive)."); 503 | end Find_Like_Help; 504 | 505 | function Find_Like_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 506 | begin 507 | for Word of Command_Line loop 508 | SP.Searches.Find_Like (Srch, To_String (Word)); 509 | end loop; 510 | 511 | Search_Updated (Srch); 512 | return Command_Success; 513 | end Find_Like_Exec; 514 | 515 | ---------------------------------------------------------------------------- 516 | 517 | procedure Exclude_Like_Help is 518 | begin 519 | Put_Line ("Provides text to search for (case insensitive)."); 520 | end Exclude_Like_Help; 521 | 522 | function Exclude_Like_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 523 | begin 524 | for Word of Command_Line loop 525 | SP.Searches.Exclude_Like (Srch, To_String (Word)); 526 | end loop; 527 | 528 | Search_Updated (Srch); 529 | return Command_Success; 530 | end Exclude_Like_Exec; 531 | 532 | ---------------------------------------------------------------------------- 533 | 534 | procedure Find_Regex_Help is 535 | begin 536 | Put_Line ("Provides regex to search for."); 537 | end Find_Regex_Help; 538 | 539 | function Find_Regex_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 540 | begin 541 | for Word of Command_Line loop 542 | SP.Searches.Find_Regex (Srch, To_String (Word)); 543 | end loop; 544 | 545 | Search_Updated (Srch); 546 | return Command_Success; 547 | end Find_Regex_Exec; 548 | 549 | ---------------------------------------------------------------------------- 550 | 551 | procedure Exclude_Regex_Help is 552 | begin 553 | Put_Line ("Provides Regex to search for."); 554 | end Exclude_Regex_Help; 555 | 556 | function Exclude_Regex_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 557 | begin 558 | for Word of Command_Line loop 559 | SP.Searches.Exclude_Regex (Srch, To_String (Word)); 560 | end loop; 561 | 562 | Search_Updated (Srch); 563 | return Command_Success; 564 | end Exclude_Regex_Exec; 565 | 566 | ---------------------------------------------------------------------------- 567 | 568 | procedure List_Filters is 569 | begin 570 | Put_Line ("Lists the currently bound filters."); 571 | end List_Filters; 572 | 573 | function List_Filters_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 574 | Filter_Names : constant String_Vectors.Vector := SP.Searches.List_Filter_Names (Srch); 575 | begin 576 | if not Command_Line.Is_Empty then 577 | Put_Line ("Ignoring unnecessary command line parameters."); 578 | return Command_Failed; 579 | end if; 580 | for Name of Filter_Names loop 581 | Put_Line (To_String (Name)); 582 | end loop; 583 | return Command_Success; 584 | end List_Filters_Exec; 585 | ---------------------------------------------------------------------------- 586 | 587 | procedure Reorder_Help is 588 | begin 589 | Put_Line ("Reorders filters, possibly dropping some of them."); 590 | end Reorder_Help; 591 | 592 | function Parse_Positive_Vector (Command_Line : in String_Vectors.Vector) return SP.Searches.Positive_Vectors.Vector is 593 | Index : Positive := Positive'Last; 594 | begin 595 | return Indices : SP.Searches.Positive_Vectors.Vector do 596 | for Index_String of Command_Line loop 597 | if Try_Parse (ASU.To_String (Index_String), Index) then 598 | Indices.Append (Index); 599 | else 600 | Put_Line (Index_String & " is not an index"); 601 | end if; 602 | end loop; 603 | end return; 604 | end Parse_Positive_Vector; 605 | 606 | function Reorder_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 607 | begin 608 | if SP.Searches.Num_Filters (Srch) = 0 then 609 | Put_Line ("There are no filters to reorder."); 610 | return Command_Failed; 611 | end if; 612 | 613 | if Command_Line.Is_Empty then 614 | Put_Line ("Filter indices to keep must be provided with reorder."); 615 | return Command_Failed; 616 | end if; 617 | 618 | declare 619 | Indices : constant SP.Searches.Positive_Vectors.Vector := Parse_Positive_Vector (Command_Line); 620 | Max_Filter_Index : constant Natural := SP.Searches.Num_Filters (Srch); 621 | use type Ada.Containers.Count_Type; 622 | begin 623 | 624 | -- Prefer to not alter anything if the parameters are borked. 625 | if Indices.Length /= Command_Line.Length then 626 | return Command_Failed; 627 | end if; 628 | 629 | if (for some Index of Indices => Natural (Index) > Max_Filter_Index) then 630 | Put_Line ("There are" & Max_Filter_Index'Image & " filters."); 631 | Put_Line ("All filter indices must be in the range 1 .." & Max_Filter_Index'Image); 632 | return Command_Failed; 633 | end if; 634 | 635 | if (for some I in 1 .. Max_Filter_Index => not Indices.Contains (I)) then 636 | Put_Line ("All filter indices must be provided."); 637 | Put_Line ("Use 'drop' to remove filters you don't want by index."); 638 | return Command_Failed; 639 | end if; 640 | 641 | SP.Searches.Reorder_Filters (Srch, Indices); 642 | return Command_Success; 643 | end; 644 | end Reorder_Exec; 645 | 646 | ---------------------------------------------------------------------------- 647 | 648 | procedure Drop_Help is 649 | begin 650 | Put_Line ("Drops given filters, or the most recent filter if non given."); 651 | end Drop_Help; 652 | 653 | function Drop_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 654 | begin 655 | if Command_Line.Is_Empty then 656 | SP.Searches.Pop_Filter (Srch); 657 | Search_Updated (Srch); 658 | return Command_Success; 659 | end if; 660 | 661 | declare 662 | package Positive_Vector_Sorting is new SP.Searches.Positive_Vectors.Generic_Sorting ("<" => ">"); 663 | Index : Positive := Positive'Last; 664 | Indices : SP.Searches.Positive_Vectors.Vector; 665 | use type Ada.Containers.Count_Type; 666 | begin 667 | for Index_String of Command_Line loop 668 | if Try_Parse (ASU.To_String (Index_String), Index) then 669 | if Natural (Index) > SP.Searches.Num_Filters (Srch) then 670 | Put_Line ("Filter index out of range:" & Index'Image); 671 | else 672 | Indices.Append (Index); 673 | end if; 674 | else 675 | Put_Line (Index_String & " is not an index."); 676 | end if; 677 | end loop; 678 | 679 | -- Prefer to not alter anything if the parameters are borked. 680 | if Indices.Length /= Command_Line.Length then 681 | return Command_Failed; 682 | end if; 683 | 684 | -- Drop filters in reverse order to preserve semantics while keeping 685 | -- the interface of SP.Searches simple. 686 | Positive_Vector_Sorting.Sort (Indices); 687 | for I of Indices loop 688 | SP.Searches.Drop_Filter (Srch, I); 689 | end loop; 690 | return Command_Success; 691 | end; 692 | end Drop_Exec; 693 | 694 | ---------------------------------------------------------------------------- 695 | 696 | procedure Pop_Help is 697 | begin 698 | Put_Line ("Pops the last applied filter from the search."); 699 | end Pop_Help; 700 | 701 | function Pop_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 702 | begin 703 | if not Command_Line.Is_Empty then 704 | Put_Line ("Ignoring unnecessary command line parameters."); 705 | return Command_Failed; 706 | end if; 707 | SP.Searches.Pop_Filter (Srch); 708 | 709 | Search_Updated (Srch); 710 | return Command_Success; 711 | end Pop_Exec; 712 | 713 | ---------------------------------------------------------------------------- 714 | 715 | procedure Clear_Filters_Help is 716 | begin 717 | Put_Line ("Pops all filters."); 718 | end Clear_Filters_Help; 719 | 720 | function Clear_Filters_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 721 | begin 722 | pragma Unreferenced (Command_Line); 723 | SP.Searches.Clear_Filters (Srch); 724 | return Command_Success; 725 | end Clear_Filters_Exec; 726 | 727 | ---------------------------------------------------------------------------- 728 | 729 | procedure Matching_Contexts_Help is 730 | begin 731 | Put_Line ("Lists the Contexts currently matching all filters."); 732 | New_Line; 733 | Put_Line ("match-contexts Prints up to max-results results"); 734 | Put_Line ("match-contexts N Prints the first N results"); 735 | Put_Line ("match-contexts M N Prints the M ... N results"); 736 | end Matching_Contexts_Help; 737 | 738 | function Matching_Contexts_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 739 | Contexts : constant SP.Contexts.Context_Vectors.Vector := SP.Searches.Matching_Contexts (Srch); 740 | First : Positive := 1; 741 | Last : Positive := Positive'Last; 742 | begin 743 | case Command_Line.Length is 744 | when 2 => 745 | if Try_Parse (To_String (Command_Line.First_Element), First) 746 | and then Try_Parse (To_String (Command_Line.Element (2)), Last) 747 | and then First <= Last 748 | then 749 | SP.Searches.Print_Contexts_With_Cancellation (Srch, Contexts, First, Last); 750 | else 751 | SP.Terminal.Put_Line ("Bad number of results to give."); 752 | return Command_Failed; 753 | end if; 754 | when 1 => 755 | if not Try_Parse (To_String(Command_Line.First_Element), Last) then 756 | SP.Terminal.Put_Line ("Bad number of results to give."); 757 | return Command_Failed; 758 | end if; 759 | 760 | SP.Searches.Print_Contexts_With_Cancellation (Srch, Contexts, 1, Last); 761 | when 0 => 762 | SP.Searches.Print_Contexts_With_Cancellation (Srch, Contexts, 1, SP.Searches.Get_Max_Results (Srch)); 763 | when others => 764 | SP.Terminal.Put_Line ("Expected either no parameter or 1 to give a maximum number of results to return."); 765 | return Command_Failed; 766 | end case; 767 | return Command_Success; 768 | end Matching_Contexts_Exec; 769 | 770 | ---------------------------------------------------------------------------- 771 | 772 | procedure Matching_Files_Help is 773 | begin 774 | Put_Line ("Lists files currently matching all filters."); 775 | end Matching_Files_Help; 776 | 777 | function Matching_Files_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 778 | Contexts : constant SP.Contexts.Context_Vectors.Vector := SP.Searches.Matching_Contexts (Srch); 779 | Files : constant String_Sets.Set := SP.Contexts.Files_In (Contexts); 780 | begin 781 | pragma Unreferenced (Command_Line); 782 | 783 | SP.Terminal.New_Line; 784 | for File of Files loop 785 | SP.Terminal.Put_Line (File); 786 | end loop; 787 | New_Line; 788 | Put_Line ("Matching files:" & Files.Length'Image); 789 | 790 | return Command_Success; 791 | end Matching_Files_Exec; 792 | 793 | ---------------------------------------------------------------------------- 794 | 795 | procedure Quit_Help is 796 | begin 797 | Put_Line ("Quits this program."); 798 | end Quit_Help; 799 | 800 | function Quit_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 801 | begin 802 | pragma Unreferenced (Srch, Command_Line); 803 | return Command_Exit_Requested; 804 | end Quit_Exec; 805 | 806 | ---------------------------------------------------------------------------- 807 | 808 | procedure Set_Context_Width_Help is 809 | begin 810 | Put_Line ("List lines matching the current filter."); 811 | end Set_Context_Width_Help; 812 | 813 | function Set_Context_Width_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 814 | Context_Width : Natural := 0; 815 | begin 816 | case Natural (Command_Line.Length) is 817 | when 0 => 818 | Put_Line ("Removing context width restriction"); 819 | SP.Searches.Set_Context_Width (Srch, SP.Searches.No_Context_Width); 820 | when 1 => 821 | Context_Width := Natural'Value (To_String (Command_Line.First_Element)); 822 | SP.Searches.Set_Context_Width (Srch, Context_Width); 823 | Put_Line ("Context width set to " & Context_Width'Image); 824 | when others => 825 | Put_Line 826 | ("Expected a single value for the context width or no value to remove context width restriction."); 827 | return Command_Failed; 828 | end case; 829 | return Command_Success; 830 | exception 831 | when Constraint_Error => 832 | Put_Line ("Invalid context width: " & To_String (Command_Line.First_Element)); 833 | return Command_Failed; 834 | end Set_Context_Width_Exec; 835 | 836 | ---------------------------------------------------------------------------- 837 | 838 | procedure Set_Max_Results_Help is 839 | begin 840 | Put_Line ("Sets the maximum number of results which can be returned."); 841 | end Set_Max_Results_Help; 842 | 843 | function Set_Max_Results_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 844 | Max_Results : Natural := SP.Searches.No_Max_Results; 845 | begin 846 | case Natural (Command_Line.Length) is 847 | when 0 => 848 | Put_Line ("Removing maximum result restriction"); 849 | SP.Searches.Set_Max_Results (Srch, SP.Searches.No_Max_Results); 850 | when 1 => 851 | Max_Results := Natural'Value (To_String (Command_Line.First_Element)); 852 | if Max_Results = 0 then 853 | Put_Line ("Must return at least 1 result."); 854 | return Command_Failed; 855 | end if; 856 | SP.Searches.Set_Max_Results (Srch, Max_Results); 857 | Put_Line ("Maximum results set to " & Max_Results'Image); 858 | when others => 859 | Put_Line 860 | ("Expected a single value for the number of maximum results or no value to remove restriction on number of results."); 861 | return Command_Failed; 862 | end case; 863 | return Command_Success; 864 | exception 865 | when Constraint_Error => 866 | Put_Line ("Invalid number of maximum results: " & To_String (Command_Line.First_Element)); 867 | return Command_Failed; 868 | end Set_Max_Results_Exec; 869 | 870 | ---------------------------------------------------------------------------- 871 | 872 | procedure Enable_Search_On_Filters_Changed_Help is 873 | begin 874 | Put_Line ("Enables searching automatically when filters are changed."); 875 | end Enable_Search_On_Filters_Changed_Help; 876 | 877 | function Enable_Search_On_Filters_Changed_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 878 | begin 879 | if not Command_Line.Is_Empty then 880 | Put_Line ("Command line should be empty."); 881 | return Command_Failed; 882 | end if; 883 | SP.Searches.Set_Search_On_Filters_Changed (Srch, True); 884 | return Command_Success; 885 | end Enable_Search_On_Filters_Changed_Exec; 886 | 887 | procedure Disable_Search_On_Filters_Changed_Help is 888 | begin 889 | Put_Line ("Disables searching automatically when filters are changed."); 890 | end Disable_Search_On_Filters_Changed_Help; 891 | 892 | function Disable_Search_On_Filters_Changed_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 893 | begin 894 | if not Command_Line.Is_Empty then 895 | Put_Line ("Command line should be empty."); 896 | return Command_Failed; 897 | end if; 898 | SP.Searches.Set_Search_On_Filters_Changed (Srch, False); 899 | return Command_Success; 900 | end Disable_Search_On_Filters_Changed_Exec; 901 | 902 | ---------------------------------------------------------------------------- 903 | 904 | procedure Enable_Line_Numbers_Help is 905 | begin 906 | Put_Line ("Enables line numbers in context output."); 907 | end Enable_Line_Numbers_Help; 908 | 909 | function Enable_Line_Numbers_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 910 | begin 911 | if not Command_Line.Is_Empty then 912 | Put_Line ("Command line should be empty."); 913 | return Command_Failed; 914 | end if; 915 | SP.Searches.Set_Print_Line_Numbers (Srch, True); 916 | return Command_Success; 917 | end Enable_Line_Numbers_Exec; 918 | 919 | procedure Disable_Line_Numbers_Help is 920 | begin 921 | Put_Line ("Disables line numbers in context output."); 922 | end Disable_Line_Numbers_Help; 923 | 924 | function Disable_Line_Numbers_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 925 | begin 926 | if not Command_Line.Is_Empty then 927 | Put_Line ("Command line should be empty."); 928 | return Command_Failed; 929 | end if; 930 | SP.Searches.Set_Print_Line_Numbers (Srch, False); 931 | return Command_Success; 932 | end Disable_Line_Numbers_Exec; 933 | 934 | ---------------------------------------------------------------------------- 935 | 936 | procedure Enable_Line_Colors_Help is 937 | begin 938 | Put_Line ("Enables line colors in context output."); 939 | end Enable_Line_Colors_Help; 940 | 941 | function Enable_Line_Colors_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 942 | begin 943 | if not Command_Line.Is_Empty then 944 | Put_Line ("Command line should be empty."); 945 | return Command_Failed; 946 | end if; 947 | SP.Searches.Set_Line_Colors_Enabled (Srch, True); 948 | return Command_Success; 949 | end Enable_Line_Colors_Exec; 950 | 951 | procedure Disable_Line_Colors_Help is 952 | begin 953 | Put_Line ("Disables line colors in context output."); 954 | end Disable_Line_Colors_Help; 955 | 956 | function Disable_Line_Colors_Exec (Srch : in out SP.Searches.Search; Command_Line : in String_Vectors.Vector) return Command_Result is 957 | begin 958 | if not Command_Line.Is_Empty then 959 | Put_Line ("Command line should be empty."); 960 | return Command_Failed; 961 | end if; 962 | SP.Searches.Set_Line_Colors_Enabled (Srch, False); 963 | return Command_Success; 964 | end Disable_Line_Colors_Exec; 965 | 966 | 967 | ---------------------------------------------------------------------------- 968 | 969 | procedure Make_Command (Command : String; Simple_Help : String; Help : Help_Proc; Exec : Exec_Proc) with 970 | Pre => Command'Length > 0 and then not Command_Map.Contains (To_Unbounded_String (Command)) 971 | is 972 | begin 973 | Command_Map.Insert (To_Unbounded_String (Command), (To_Unbounded_String (Simple_Help), Help, Exec)); 974 | end Make_Command; 975 | 976 | begin 977 | 978 | -- Actions 979 | 980 | Make_Command ("help", "Print commands or help for a specific command", Help_Help'Access, Help_Exec'Access); 981 | Make_Command ("reload", "Reloads the file cache.", Reload_Help'Access, Reload_Exec'Access); 982 | Make_Command ("stats", "Print file cache statistics.", Stats_Help'Access, Stats_Exec'Access); 983 | Make_Command ("source", "Loads a configuration from file.", Source_Help'Access, Source_Exec'Access); 984 | Make_Command ("test", "Check to see which filters would trigger on a line of text.", Test_Help'Access, Test_Exec'Access); 985 | 986 | -- Filters 987 | 988 | Make_Command ("find-text", "Adds filter text.", Find_Text_Help'Access, Find_Text_Exec'Access); 989 | Make_Command ("exclude-text", "Adds text to exclude.", Exclude_Text_Help'Access, Exclude_Text_Exec'Access); 990 | Make_Command ("find-like", "Adds filter text (case insensitive).", Find_Like_Help'Access, Find_Like_Exec'Access); 991 | Make_Command ("exclude-like", "Adds text to exclude (case insensitive).", Exclude_Like_Help'Access, Exclude_Like_Exec'Access); 992 | Make_Command ("find-regex", "Adds filter regex.", Find_Regex_Help'Access, Find_Regex_Exec'Access); 993 | Make_Command ("exclude-regex", "Adds regex to exclude.", Exclude_Regex_Help'Access, Exclude_Regex_Exec'Access); 994 | Make_Command ("list-filters", "Lists all applied filters.", List_Filters'Access, List_Filters_Exec'Access); 995 | 996 | Make_Command ("reorder", "Reorder filters by index.", Reorder_Help'Access, Reorder_Exec'Access); 997 | Make_Command ("drop", "Drops the filters at the given indices.", Drop_Help'Access, Drop_Exec'Access); 998 | Make_Command ("pop", "Pops the last applied filter.", Pop_Help'Access, Pop_Exec'Access); 999 | Make_Command ("clear-filters", "Pops all filters.", Clear_Filters_Help'Access, Clear_Filters_Exec'Access); 1000 | 1001 | -- Results 1002 | 1003 | Make_Command 1004 | ("match-contexts", "Lists contexts matching the current filter.", Matching_Contexts_Help'Access, 1005 | Matching_Contexts_Exec'Access); 1006 | Make_Command 1007 | ("match-files", "Lists files matching the current filter.", Matching_Files_Help'Access, 1008 | Matching_Files_Exec'Access); 1009 | 1010 | -- Global configuration 1011 | 1012 | Make_Command ("add-dirs", "Adds directory to the search list.", Add_Dirs_Help'Access, Add_Dirs_Exec'Access); 1013 | Make_Command 1014 | ("list-dirs", "List the directories in the search list.", List_Dirs_Help'Access, List_Dirs_Exec'Access); 1015 | Make_Command 1016 | ("clear-dirs", "Removes all directories from the search list.", Clear_Dirs_Help'Access, Clear_Dirs_Exec'Access); 1017 | 1018 | Make_Command ("only-exts", "Adds extensions to find results in.", Add_Extensions_Help'Access, Add_Extensions_Exec'Access); 1019 | Make_Command 1020 | ("remove-exts", "Removes an extension filter from the search.", Remove_Extensions_Help'Access, 1021 | Remove_Extensions_Exec'Access); 1022 | Make_Command ("clear-exts", "Clears extension filters.", Clear_Extensions_Help'Access, Clear_Extensions_Exec'Access); 1023 | Make_Command ("list-exts", "List current extensions.", List_Extensions_Help'Access, List_Extensions_Exec'Access); 1024 | 1025 | Make_Command 1026 | ("set-context-width", "Sets the width of the context in which to find matches.", Set_Context_Width_Help'Access, 1027 | Set_Context_Width_Exec'Access); 1028 | Make_Command 1029 | ("set-max-results", "Sets the maximum results returned before only the total number of results are returned.", 1030 | Set_Max_Results_Help'Access, Set_Max_Results_Exec'Access); 1031 | 1032 | Make_Command 1033 | ("enable-auto-search", "Search when filters are changed automatically", Enable_Search_On_Filters_Changed_Help'Access, 1034 | Enable_Search_On_Filters_Changed_Exec'Access); 1035 | 1036 | Make_Command 1037 | ("disable-auto-search", "Turn off search when filters are changed automatically", Disable_Search_On_Filters_Changed_Help'Access, 1038 | Disable_Search_On_Filters_Changed_Exec'Access); 1039 | 1040 | Make_Command 1041 | ("enable-line-numbers", "Enables prefixing of lines with line numbers.", Enable_Line_Numbers_Help'Access, 1042 | Enable_Line_Numbers_Exec'Access); 1043 | Make_Command 1044 | ("disable-line-numbers", "Disables prefixing of lines with line numbers.", Disable_Line_Numbers_Help'Access, 1045 | Disable_Line_Numbers_Exec'Access); 1046 | 1047 | Make_Command 1048 | ("enable-line-colors", "Enables colorizing lines with matches.", Enable_Line_Colors_Help'Access, 1049 | Enable_Line_Colors_Exec'Access); 1050 | Make_Command 1051 | ("disable-line-colors", "Disables colorizing lines with matches.", Disable_Line_Colors_Help'Access, 1052 | Disable_Line_Colors_Exec'Access); 1053 | 1054 | -- Quit 1055 | 1056 | Make_Command ("quit", "Exits the search program.", Quit_Help'Access, Quit_Exec'Access); 1057 | Make_Command ("exit", "Exits the search program.", Quit_Help'Access, Quit_Exec'Access); 1058 | end SP.Commands; 1059 | --------------------------------------------------------------------------------