[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/wisi 42884728cd 2/2: Finish commit for upgrade to 4.1.1
|
From: |
Stephen Leake |
|
Subject: |
[elpa] externals/wisi 42884728cd 2/2: Finish commit for upgrade to 4.1.1 |
|
Date: |
Tue, 1 Nov 2022 17:24:24 -0400 (EDT) |
branch: externals/wisi
commit 42884728cd69c27e8218ade9bb9accfec3e77169
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>
Finish commit for upgrade to 4.1.1
---
gen_emacs_wisi_packrat_parse.adb | 180 ---------------
gen_emacs_wisi_packrat_parse.ads | 42 ----
gen_run_wisi_packrat_parse.adb | 241 -------------------
gen_run_wisi_packrat_parse.ads | 36 ---
gnat-core.el | 487 ---------------------------------------
5 files changed, 986 deletions(-)
diff --git a/gen_emacs_wisi_packrat_parse.adb b/gen_emacs_wisi_packrat_parse.adb
deleted file mode 100644
index b4e95f604f..0000000000
--- a/gen_emacs_wisi_packrat_parse.adb
+++ /dev/null
@@ -1,180 +0,0 @@
--- Abstract :
---
--- See spec.
---
--- Copyright (C) 2018 All Rights Reserved.
---
--- This program is free software; you can redistribute it and/or
--- modify it under terms of the GNU General Public License as
--- published by the Free Software Foundation; either version 3, or (at
--- your option) any later version. This program is distributed in the
--- hope that it will be useful, but WITHOUT ANY WARRANTY; without even
--- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--- PURPOSE. See the GNU General Public License for more details. You
--- should have received a copy of the GNU General Public License
--- distributed with this program; see file COPYING. If not, write to
--- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
--- MA 02110-1335, USA.
-
-pragma License (GPL);
-
-with Ada.Command_Line;
-with Ada.Exceptions;
-with Ada.Strings.Fixed;
-with Ada.Strings.Unbounded;
-with Ada.Text_IO; use Ada.Text_IO;
-with Emacs_Wisi_Common_Parse; use Emacs_Wisi_Common_Parse;
-with GNAT.OS_Lib;
-with GNAT.Traceback.Symbolic;
-with System.Storage_Elements;
-with WisiToken.Lexer;
-with WisiToken.Parse.Packrat;
-with WisiToken.Text_IO_Trace;
-procedure Gen_Emacs_Wisi_Parse_Packrat
-is
- use WisiToken; -- "+", "-" Unbounded_string
-
- Trace : aliased WisiToken.Text_IO_Trace.Trace (Descriptor'Access);
- Parser : WisiToken.Parse.Packrat.Parser;
- Parse_Data : aliased Parse_Data_Type (Parser.Line_Begin_Token'Access);
-
-begin
- Create_Parser (Parser, Trace'Unrestricted_Access,
Parse_Data'Unchecked_Access);
-
- declare
- use Ada.Command_Line;
- begin
- case Argument_Count is
- when 0 =>
- null;
-
- when others =>
- Usage (Name);
- raise Programmer_Error with "invalid option count: " & Integer'Image
(Argument_Count);
- end case;
- end;
-
- Put_Line (Name & " " & Version & ", protocol version " & Protocol_Version);
-
- -- Read commands and tokens from standard_input via GNAT.OS_Lib,
- -- send results to standard_output.
- loop
- Put (Prompt); Flush;
- declare
- Command_Length : constant Integer := Get_Command_Length;
- Command_Line : aliased String (1 .. Command_Length);
- Last : Integer;
-
- function Match (Target : in String) return Boolean
- is begin
- Last := Command_Line'First + Target'Length - 1;
- return Last <= Command_Line'Last and then Command_Line
(Command_Line'First .. Last) = Target;
- end Match;
- begin
- Read_Input (Command_Line'Address, Command_Length);
-
- Put_Line (";; " & Command_Line);
-
- if Match ("parse") then
- -- Args: see Usage
- -- Input: <source text>
- -- Response:
- -- [response elisp vector]...
- -- [elisp error form]...
- -- prompt
- declare
- use Wisi;
- Cl_Params : constant Command_Line_Params := Get_Cl_Params
(Command_Line, Last);
- Buffer : Ada.Strings.Unbounded.String_Access;
-
- procedure Clean_Up
- is begin
- Parser.Lexer.Discard_Rest_Of_Input;
- Parser.Put_Errors (-Cl_Param.Source_File_Name);
- Ada.Strings.Unbounded.Free (Buffer);
- end Clean_Up;
-
- begin
- -- Computing Line_Count in elisp allows parsing in parallel
with
- -- sending source text.
-
- Trace_Parse := Cl_Params.Parse_Verbosity;
- Trace_McKenzie := Cl_Params.McKenzie_Verbosity;
- Trace_Action := Cl_Params.Action_Verbosity;
- Debug_Mode := Cl_Params.Debug_Mode;
-
- Parse_Data.Initialize
- (Post_Parse_Action => Cl_Params.Post_Parse_Action,
- Descriptor => Descriptor'Access,
- Source_File_Name => -Cl_Params.Source_File_Name,
- Line_Count => Cl_Params.Line_Count,
- Params => Command_Line (Last + 2 ..
Command_Line'Last));
-
- Buffer := new String (1 .. Cl_Params.Byte_Count);
- Read_Input (Buffer (1)'Address, Cl_Params.Byte_Count);
-
- Parser.Lexer.Reset_With_String_Access (Buffer);
- Parser.Parse;
- Parser.Execute_Actions;
- Put (Parse_Data);
- Clean_Up;
-
- exception
- when Syntax_Error =>
- Clean_Up;
- Put_Line ("(parse_error)");
-
- when E : Parse_Error =>
- Clean_Up;
- Put_Line ("(parse_error """ & Ada.Exceptions.Exception_Message
(E) & """)");
-
- when E : Fatal_Error =>
- Clean_Up;
- Put_Line ("(error """ & Ada.Exceptions.Exception_Message (E) &
""")");
- end;
-
- elsif Match ("noop") then
- -- Args: <source byte count>
- -- Input: <source text>
- -- Response: prompt
- declare
- Byte_Count : constant Integer :=
Get_Integer (Command_Line, Last);
- Buffer : constant Ada.Strings.Unbounded.String_Access :=
new String (1 .. Byte_Count);
- Token : Base_Token;
- Lexer_Error : Boolean;
- pragma Unreferenced (Lexer_Error);
- begin
- Token.ID := Invalid_Token_ID;
- Read_Input (Buffer (1)'Address, Byte_Count);
-
- Parser.Lexer.Reset_With_String_Access (Buffer);
- loop
- exit when Token.ID = Parser.Trace.Descriptor.EOF_ID;
- Lexer_Error := Parser.Lexer.Find_Next (Token);
- end loop;
- exception
- when Syntax_Error =>
- Parser.Lexer.Discard_Rest_Of_Input;
- end;
-
- elsif Match ("quit") then
- exit;
-
- else
- Put_Line ("(error ""bad command: '" & Command_Line & "'"")");
- end if;
- exception
- when E : Protocol_Error =>
- -- don't exit the loop; allow debugging bad elisp
- Put_Line ("(error ""protocol error "": " &
Ada.Exceptions.Exception_Message (E) & """)");
- end;
- end loop;
-exception
-when E : others =>
- Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
- New_Line (2);
- Put_Line
- ("(error ""unhandled exception: " & Ada.Exceptions.Exception_Name (E) &
": " &
- Ada.Exceptions.Exception_Message (E) & """)");
- Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
-end Gen_Emacs_Wisi_Parse_Packrat;
diff --git a/gen_emacs_wisi_packrat_parse.ads b/gen_emacs_wisi_packrat_parse.ads
deleted file mode 100644
index 79c69ecf89..0000000000
--- a/gen_emacs_wisi_packrat_parse.ads
+++ /dev/null
@@ -1,42 +0,0 @@
--- Abstract :
---
--- Generic Emacs background process; packrat parse token stream,
--- return parser actions.
---
--- See gen_run_wisi_parse_packrat.ads for a standalone version.
---
--- References :
---
--- See gen_emacs_wisi_parse.ads
---
--- Copyright (C) 2018 Free Software Foundation, Inc.
---
--- This program is free software; you can redistribute it and/or
--- modify it under terms of the GNU General Public License as
--- published by the Free Software Foundation; either version 3, or (at
--- your option) any later version. This program is distributed in the
--- hope that it will be useful, but WITHOUT ANY WARRANTY; without even
--- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--- PURPOSE. See the GNU General Public License for more details. You
--- should have received a copy of the GNU General Public License
--- distributed with this program; see file COPYING. If not, write to
--- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
--- MA 02110-1335, USA.
-
-pragma License (GPL);
-
-with WisiToken.Parse.Packrat;
-with WisiToken.Syntax_Trees;
-with WisiToken.Wisi_Runtime;
-generic
- type Parse_Data_Type is new WisiToken.Wisi_Runtime.Parse_Data_Type with
private;
-
- Name : in String; -- for Usage, error messages.
"_wisi_parse_packrat" will be appended
- Descriptor : in WisiToken.Descriptor;
-
- with procedure Create_Parser
- (Parser : out WisiToken.Parse.Packrat.Parser;
- Trace : not null access WisiToken.Trace'Class;
- User_Data : in WisiToken.Syntax_Trees.User_Data_Access);
-
-procedure Gen_Emacs_Wisi_Parse_Packrat;
diff --git a/gen_run_wisi_packrat_parse.adb b/gen_run_wisi_packrat_parse.adb
deleted file mode 100644
index fb3e900a09..0000000000
--- a/gen_run_wisi_packrat_parse.adb
+++ /dev/null
@@ -1,241 +0,0 @@
--- Abstract :
---
--- See spec.
---
--- Copyright (C) 2018 All Rights Reserved.
---
--- This program is free software; you can redistribute it and/or
--- modify it under terms of the GNU General Public License as
--- published by the Free Software Foundation; either version 3, or (at
--- your option) any later version. This program is distributed in the
--- hope that it will be useful, but WITHOUT ANY WARRANTY; without even
--- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--- PURPOSE. See the GNU General Public License for more details. You
--- should have received a copy of the GNU General Public License
--- distributed with this program; see file COPYING. If not, write to
--- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
--- MA 02110-1335, USA.
-
-pragma License (GPL);
-
-with Ada.Command_Line;
-with Ada.Exceptions;
-with Ada.IO_Exceptions;
-with Ada.Real_Time;
-with Ada.Strings.Unbounded;
-with Ada.Text_IO; use Ada.Text_IO;
-with GNAT.Traceback.Symbolic;
-with WisiToken.Lexer;
-with WisiToken.Text_IO_Trace;
-procedure Gen_Run_Wisi_Parse_Packrat
-is
- use WisiToken; -- Token_ID, "+", "-" Unbounded_string
-
- Trace : aliased WisiToken.Text_IO_Trace.Trace (Descriptor'Access);
- Parser : WisiToken.Parse.Packrat.Parser;
- Parse_Data : aliased Parse_Data_Type (Parser.Line_Begin_Token'Access);
-
- procedure Put_Usage
- is begin
- Put_Line ("usage: " & Name & "_wisi_parse <file_name> <parse_action>
[options]");
- Put_Line ("parse_action: {Navigate | Face | Indent}");
- Put_Line ("options:");
- Put_Line ("--verbosity n m l:");
- Put_Line (" n: parser; m: mckenzie; l: action");
- Put_Line (" 0 - only report parse errors");
- Put_Line (" 1 - shows spawn/terminate parallel parsers, error recovery
enter/exit");
- Put_Line (" 2 - add each parser cycle, error recovery enqueue/check");
- Put_Line (" 3 - parse stack in each cycle, error recovery parse
actions");
- Put_Line (" 4 - add lexer debug");
- Put_Line ("--lang_params <language-specific params>");
- Put_Line ("--lexer_only : only run lexer, for profiling");
- Put_Line ("--repeat_count n : repeat parse count times, for profiling;
default 1");
- Put_Line ("--pause : when repeating, prompt for <enter> after each
parse; allows seeing memory leaks");
- New_Line;
- end Put_Usage;
-
- Source_File_Name : Ada.Strings.Unbounded.Unbounded_String;
- Post_Parse_Action : WisiToken.Wisi_Runtime.Post_Parse_Action_Type;
-
- Line_Count : WisiToken.Line_Number_Type := 1;
- Lexer_Only : Boolean := False;
- Repeat_Count : Integer := 1;
- Pause : Boolean := False;
- Arg : Integer;
- Lang_Params : Ada.Strings.Unbounded.Unbounded_String;
- Start : Ada.Real_Time.Time;
-begin
- Create_Parser (Parser, Trace'Unrestricted_Access,
Parse_Data'Unchecked_Access);
-
- declare
- use Ada.Command_Line;
- begin
- if Argument_Count < 1 then
- Put_Usage;
- Set_Exit_Status (Failure);
- return;
- end if;
-
- Source_File_Name := +Ada.Command_Line.Argument (1);
- Post_Parse_Action := WisiToken.Wisi_Runtime.Post_Parse_Action_Type'Value
(Ada.Command_Line.Argument (2));
- Arg := 3;
-
- loop
- exit when Arg > Argument_Count;
-
- if Argument (Arg) = "--verbosity" then
- WisiToken.Trace_Parse := Integer'Value (Argument (Arg + 1));
- WisiToken.Trace_McKenzie := Integer'Value (Argument (Arg + 2));
- WisiToken.Trace_Action := Integer'Value (Argument (Arg + 3));
- Arg := Arg + 4;
-
- elsif Argument (Arg) = "--lang_params" then
- Lang_Params := +Argument (Arg + 1);
- Arg := Arg + 2;
-
- elsif Argument (Arg) = "--lexer_only" then
- Lexer_Only := True;
- Arg := Arg + 1;
-
- elsif Argument (Arg) = "--pause" then
- Pause := True;
- Arg := Arg + 1;
-
- elsif Argument (Arg) = "--repeat_count" then
- Repeat_Count := Integer'Value (Argument (Arg + 1));
- Arg := Arg + 2;
-
- else
- Put_Line ("unrecognized option: '" & Argument (Arg) & "'");
- Put_Usage;
- return;
- end if;
- end loop;
- end;
-
- -- Do this after setting Trace_Parse so lexer verbosity is set
- begin
- Parser.Lexer.Reset_With_File (-Source_File_Name);
- exception
- when Ada.IO_Exceptions.Name_Error =>
- Put_Line (Standard_Error, "'" & (-Source_File_Name) & "' cannot be
opened");
- return;
- end;
-
- -- See comment in wisi-wisi_runtime.ads for why we still need this.
- declare
- Token : Base_Token;
- Lexer_Error : Boolean;
- pragma Unreferenced (Lexer_Error);
- begin
- loop
- begin
- Lexer_Error := Parser.Lexer.Find_Next (Token);
- exit when Token.ID = Descriptor.EOF_ID;
- exception
- when WisiToken.Syntax_Error =>
- Parser.Lexer.Discard_Rest_Of_Input;
- Parser.Put_Errors (-Source_File_Name);
- Put_Line ("(lexer_error)");
- end;
- end loop;
- Line_Count := Token.Line;
- end;
-
- if WisiToken.Trace_Action > WisiToken.Outline then
- Put_Line ("line_count:" & Line_Number_Type'Image (Line_Count));
- end if;
-
- Parse_Data.Initialize
- (Post_Parse_Action => Post_Parse_Action,
- Descriptor => Descriptor'Access,
- Source_File_Name => -Source_File_Name,
- Line_Count => Line_Count,
- Params => -Lang_Params);
-
- if Repeat_Count > 1 then
- Start := Ada.Real_Time.Clock;
- end if;
-
- for I in 1 .. Repeat_Count loop
- declare
- procedure Clean_Up
- is begin
- Parser.Lexer.Discard_Rest_Of_Input;
- if Repeat_Count = 1 then
- Parser.Put_Errors (-Source_File_Name);
- end if;
- end Clean_Up;
-
- begin
- Parse_Data.Reset;
- Parser.Lexer.Reset;
-
- if Lexer_Only then
- declare
- Token : Base_Token;
- Lexer_Error : Boolean;
- pragma Unreferenced (Lexer_Error);
- begin
- Parser.Lexer.Reset;
- loop
- Lexer_Error := Parser.Lexer.Find_Next (Token);
- exit when Token.ID = Descriptor.EOF_ID;
- end loop;
- -- We don't handle errors here; that was done in the count
lines loop
- -- above.
- end;
- else
- Parser.Parse;
- Parser.Execute_Actions;
-
- if Repeat_Count = 1 then
- Parse_Data.Put;
- Parser.Put_Errors (-Source_File_Name);
- end if;
- end if;
- exception
- when WisiToken.Syntax_Error =>
- Clean_Up;
- Put_Line ("(parse_error)");
-
- when E : WisiToken.Parse_Error =>
- Clean_Up;
- Put_Line ("(parse_error """ & Ada.Exceptions.Exception_Message (E) &
""")");
-
- when E : WisiToken.Fatal_Error =>
- Clean_Up;
- Put_Line ("(error """ & Ada.Exceptions.Exception_Message (E) & """)");
- end;
-
- if Pause then
- Put_Line ("Enter to continue:");
- Flush (Standard_Output);
- declare
- Junk : constant String := Get_Line;
- pragma Unreferenced (Junk);
- begin
- null;
- end;
- end if;
- end loop;
-
- if Repeat_Count > 1 then
- declare
- use Ada.Real_Time;
- Finish : constant Time := Clock;
- begin
- Put_Line ("Total time:" & Duration'Image (To_Duration (Finish -
Start)));
- Put_Line ("per iteration:" & Duration'Image (To_Duration ((Finish -
Start) / Repeat_Count)));
- end;
- end if;
-
-exception
-when E : others =>
- Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
- New_Line (2);
- Put_Line
- ("(error ""unhandled exception: " & Ada.Exceptions.Exception_Name (E) &
": " &
- Ada.Exceptions.Exception_Message (E) & """)");
- Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
-end Gen_Run_Wisi_Parse_Packrat;
diff --git a/gen_run_wisi_packrat_parse.ads b/gen_run_wisi_packrat_parse.ads
deleted file mode 100644
index 538da1d9ea..0000000000
--- a/gen_run_wisi_packrat_parse.ads
+++ /dev/null
@@ -1,36 +0,0 @@
--- Abstract :
---
--- Run an Emacs packrate parser as a standalone executable, for debugging.
---
--- See gen_emacs_wisi_parse_packrat.ads for the Emacs background process.
---
--- Copyright (C) 2018 Free Software Foundation, Inc.
---
--- This program is free software; you can redistribute it and/or
--- modify it under terms of the GNU General Public License as
--- published by the Free Software Foundation; either version 3, or (at
--- your option) any later version. This program is distributed in the
--- hope that it will be useful, but WITHOUT ANY WARRANTY; without even
--- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
--- PURPOSE. See the GNU General Public License for more details. You
--- should have received a copy of the GNU General Public License
--- distributed with this program; see file COPYING. If not, write to
--- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,
--- MA 02110-1335, USA.
-
-pragma License (GPL);
-
-with WisiToken.Parse.Packrat;
-with WisiToken.Syntax_Trees;
-with WisiToken.Wisi_Runtime;
-generic
- type Parse_Data_Type is new WisiToken.Wisi_Runtime.Parse_Data_Type with
private;
-
- Descriptor : in WisiToken.Descriptor;
-
- with procedure Create_Parser
- (Parser : out WisiToken.Parse.Packrat.Parser;
- Trace : not null access WisiToken.Trace'Class;
- User_Data : in WisiToken.Syntax_Trees.User_Data_Access);
-
-procedure Gen_Run_Wisi_Parse_Packrat;
diff --git a/gnat-core.el b/gnat-core.el
deleted file mode 100644
index cd71ed33f3..0000000000
--- a/gnat-core.el
+++ /dev/null
@@ -1,487 +0,0 @@
-;; gnat-core.el --- Support for running GNAT tools, which support multiple
programming -*- lexical-binding:t -*-
-;; languages.
-;;
-;; GNAT is provided by AdaCore; see http://libre.adacore.com/
-;;
-;;; Copyright (C) 2012 - 2022 Free Software Foundation, Inc.
-;;
-;; Author: Stephen Leake <stephen_leake@member.fsf.org>
-;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
-;;
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-(require 'cl-lib)
-(require 'wisi-prj)
-
-;;;;; code
-
-(defcustom ada-gnat-debug-run nil
- ;; Name implies Ada, which is wrong. Kept for backward compatibility.
- "If t, compilation buffers containing a GNAT command will show
-the command. Otherwise, they will show only the output of the
-command. This applies e.g. to *gnatfind* buffers."
- :type 'boolean
- :safe #'booleanp
- :group 'ada)
-
-;;;; project file handling
-
-(cl-defstruct gnat-compiler
- "Used with wisi-compiler-* generic functions."
-
- gpr-file ;; absolute file name of GNAT project file.
- run-buffer-name ;; string; some compiler objects have no gpr file
- project-path ;; list of directories from GPR_PROJECT_PATH
- target ;; gnat --target argument.
- runtime ;; gnat --RTS argument.
- gnat-stub-opts ;; options for gnat stub
- gnat-stub-cargs ;; cargs options for gnat stub
- )
-
-;;;###autoload
-(cl-defun create-gnat-compiler
- (&key
- gpr-file
- run-buffer-name
- project-path
- target
- runtime
- gnat-stub-opts
- gnat-stub-cargs)
- ;; See note on `create-ada-prj' for why this is not a defalias.
- (make-gnat-compiler
- :gpr-file gpr-file
- :run-buffer-name run-buffer-name
- :project-path project-path
- :target target
- :runtime runtime
- :gnat-stub-opts gnat-stub-opts
- :gnat-stub-cargs gnat-stub-cargs
- ))
-
-(defun gnat-compiler-require-prj ()
- "Return current `gnat-compiler' object from current project compiler.
-Throw an error if current project does not have a gnat-compiler."
- (let* ((wisi-prj (wisi-prj-require-prj))
- (compiler (wisi-prj-compiler wisi-prj)))
- (if (gnat-compiler-p compiler)
- compiler
- (error "no gnat-compiler in current project"))))
-
-(defun gnat-prj-add-prj-dir (project compiler dir)
- "Add DIR to COMPILER.project_path, and to GPR_PROJECT_PATH in
PROJECT.file-env"
- ;; We maintain two project values for this;
- ;; project-path - a list of directories, for elisp find file
- ;; GPR_PROJECT_PATH in environment, for gnat-run
- (let ((process-environment (copy-sequence (wisi-prj-file-env project))))
- (cl-pushnew dir (gnat-compiler-project-path compiler) :test #'string-equal)
-
- (setenv "GPR_PROJECT_PATH"
- (mapconcat 'identity
- (gnat-compiler-project-path compiler) path-separator))
- (setf (wisi-prj-file-env project) (copy-sequence process-environment))
- ))
-
-;; We need a dynamic variable for 'add-to-list
-(defvar gnat--src-dirs)
-
-(defun gnat-get-paths (project compiler)
- "Add project and/or compiler source, project paths to PROJECT source-path"
- (let* ((gnat--src-dirs (wisi-prj-source-path project))
- (prj-dirs (cl-copy-list (gnat-compiler-project-path compiler))))
-
- ;; Don't need project plist obj_dirs if using a project file, so
- ;; not setting obj-dirs.
- ;;
- ;; We only need to update prj-dirs if the gpr-file is an aggregate
- ;; project that sets the project path.
-
- (condition-case-unless-debug nil
- (with-current-buffer (gnat-run-buffer project
(gnat-compiler-run-buffer-name (wisi-prj-compiler project)))
- ;; gnat list -v -P can return status 0 or 4; always lists compiler
dirs
- (gnat-run-gnat project "list" (list "-v") '(0 4))
-
- (goto-char (point-min))
-
- ;; Source path
- (search-forward "Source Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$")) ;; terminate on blank line
- (back-to-indentation) ;; skip whitespace forward
-
- ;; we use 'add-to-list here, not 'cl-pushnew, because we
- ;; want to use append to preserve the directory
- ;; order. Directory order matters for extension projects,
- ;; which can have duplicate file names.
- (add-to-list
- 'gnat--src-dirs
- (if (looking-at "<Current_Directory>")
- (directory-file-name default-directory)
- (expand-file-name ; Canonicalize path part.
- (directory-file-name
- (buffer-substring-no-properties (point) (point-at-eol)))))
- t ;; append
- #'string-equal)
- (forward-line 1))
-
- ;; Project path
- ;;
- ;; These are also added to src_dir, so compilation errors
- ;; reported in project files are found.
- (search-forward "Project Search Path:")
- (forward-line 1)
- (while (not (looking-at "^$"))
- (back-to-indentation)
- (if (looking-at "<Current_Directory>")
- (cl-pushnew (directory-file-name default-directory) prj-dirs
:test #'string-equal)
- (let ((f (expand-file-name
- (buffer-substring-no-properties (point)
(point-at-eol)))))
- (cl-pushnew f prj-dirs :test #'string-equal)
- (cl-pushnew f gnat--src-dirs :test #'string-equal)))
- (forward-line 1))
-
- )
- (error
- ;; search-forward failed. Possible causes:
- ;;
- ;; missing dirs in GPR_PROJECT_PATH => user error
- ;; missing Object_Dir => gprbuild not run yet; it will be run soon
- ;; some files are missing string quotes => user error
- ;;
- ;; We used to call gpr_query to get src-dirs, prj-dirs here; it
- ;; is tolerant of the above errors. But ignoring the errors, to
- ;; let gprbuild run with GPR_PROJECT_PATH set, is simpler.
- (pop-to-buffer (gnat-run-buffer project (gnat-compiler-run-buffer-name
(wisi-prj-compiler project))))
- (message "project search path: %s" prj-dirs)
- (message "parse gpr failed")
- ))
-
- (setf (wisi-prj-source-path project) (delete-dups gnat--src-dirs))
- (setf (gnat-compiler-project-path compiler) nil)
- (mapc (lambda (dir) (gnat-prj-add-prj-dir project compiler dir))
- prj-dirs)
- ))
-
-(defun gnat-parse-gpr (gpr-file project compiler)
- "Parse GPR-FILE, append to PROJECT (a `wisi-prj' object).
-GPR-FILE must be absolute file name.
-source-path will include compiler runtime."
- ;; this can take a long time; let the user know what's up
- (if (gnat-compiler-gpr-file compiler)
- ;; gpr-file previously set; new one must match
- (when (not (string-equal gpr-file (gnat-compiler-gpr-file compiler)))
- (error "project file %s defines a different GNAT project file than %s"
- (gnat-compiler-gpr-file compiler)
- gpr-file))
-
- (setf (gnat-compiler-gpr-file compiler) gpr-file))
-
- (gnat-get-paths project compiler))
-
-(defun gnat-parse-gpr-1 (gpr-file project)
- "For `wisi-prj-parser-alist'."
- (let ((compiler (wisi-prj-compiler project)))
- (setf (gnat-compiler-run-buffer-name compiler) gpr-file)
- (gnat-parse-gpr gpr-file project compiler)))
-
-;;;; command line tool interface
-
-(defun gnat-run-buffer-name (prj-file-name &optional prefix)
- ;; We don't use (gnat-compiler-gpr-file compiler), because multiple
- ;; wisi-prj files can use one gpr-file.
- (concat (or prefix " *gnat-run-")
- prj-file-name
- "*"))
-
-(defun gnat-run-buffer (project name)
- "Return a buffer suitable for running gnat command line tools for PROJECT"
- (let* ((buffer (get-buffer name)))
-
- (unless (buffer-live-p buffer)
- (setq buffer (get-buffer-create name))
- (when (gnat-compiler-gpr-file (wisi-prj-compiler project))
- ;; Otherwise assume `default-directory' is already correct (or
- ;; doesn't matter).
- (with-current-buffer buffer
- (setq default-directory
- (file-name-directory
- (gnat-compiler-gpr-file (wisi-prj-compiler project)))))
- ))
- buffer))
-
-(defun gnat-run (project exec command &optional err-msg expected-status)
- "Run a gnat command line tool, as \"EXEC COMMAND\".
-PROJECT is a `wisi-prj' object.
-EXEC must be an executable found on `exec-path'.
-COMMAND must be a list of strings.
-ERR-MSG must be nil or a string.
-EXPECTED-STATUS must be nil or a list of integers; throws an error if
-process status is not a member.
-
-Return process status.
-Assumes current buffer is (gnat-run-buffer)"
- (set 'buffer-read-only nil)
- (erase-buffer)
-
- (setq command (cl-delete-if 'null command))
-
- (let ((process-environment
- (append
- (wisi-prj-compile-env project)
- (wisi-prj-file-env project)
- (copy-sequence process-environment)))
- status)
-
- (when ada-gnat-debug-run
- (insert (format "GPR_PROJECT_PATH=%s\n%s " (getenv "GPR_PROJECT_PATH")
exec))
- (mapc (lambda (str) (insert (concat str " "))) command)
- (newline))
-
- (setq status (apply 'call-process exec nil t nil command))
- (cond
- ((memq status (or expected-status '(0))); success
- nil)
-
- (t ; failure
- (pop-to-buffer (current-buffer))
- (if err-msg
- (error "%s %s failed; %s" exec (car command) err-msg)
- (error "%s %s failed" exec (car command))
- ))
- )))
-
-(defun gnat-run-gnat (project command &optional switches-args expected-status)
- "Run the \"gnat\" command line tool, as \"gnat COMMAND -P<prj>
SWITCHES-ARGS\".
-COMMAND must be a string, SWITCHES-ARGS a list of strings.
-EXPECTED-STATUS must be nil or a list of integers.
-Return process status.
-Assumes current buffer is (gnat-run-buffer)"
- (let* ((compiler (wisi-prj-compiler project))
- (gpr-file (gnat-compiler-gpr-file compiler))
- (project-file-switch
- (when gpr-file
- (concat "-P" (file-name-nondirectory gpr-file))))
- (target-gnat (concat (gnat-compiler-target compiler) "gnat"))
- ;; gnat list understands --RTS without a fully qualified
- ;; path, gnat find (in particular) doesn't (but it doesn't
- ;; need to, it uses the ALI files found via the GPR)
- (runtime
- (when (and (gnat-compiler-runtime compiler) (string= command "list"))
- (list (concat "--RTS=" (gnat-compiler-runtime compiler)))))
- (cmd (append (list command) (list project-file-switch) runtime
switches-args)))
-
- (gnat-run project target-gnat cmd nil expected-status)
- ))
-
-(defun gnat-run-no-prj (command &optional dir)
- "Run \"gnat COMMAND\", with DIR as current directory.
-Return process status. Process output goes to current buffer,
-which is displayed on error."
- (set 'buffer-read-only nil)
- (erase-buffer)
-
- (when ada-gnat-debug-run
- (setq command (cl-delete-if 'null command))
- (mapc (lambda (str) (insert (concat str " "))) command)
- (newline))
-
- (let ((default-directory (or dir default-directory))
- status)
-
- (setq status (apply 'call-process "gnat" nil t nil command))
- (cond
- ((= status 0); success
- nil)
-
- (t ; failure
- (pop-to-buffer (current-buffer))
- (error "gnat %s failed" (car command)))
- )))
-
-(cl-defmethod wisi-compiler-parse-one ((compiler gnat-compiler) project name
value)
- (cond
- ((or
- (string= name "ada_project_path") ;; backward compatibility
- (string= name "gpr_project_path"))
- (let ((process-environment
- (append
- (wisi-prj-compile-env project)
- (wisi-prj-file-env project))));; reference, for
substitute-in-file-name
- (gnat-prj-add-prj-dir project compiler (expand-file-name
(substitute-in-file-name value)))))
-
- ((string= name "gnat-stub-cargs")
- (setf (gnat-compiler-gnat-stub-cargs compiler) value))
-
- ((string= name "gnat-stub-opts")
- (setf (gnat-compiler-gnat-stub-opts compiler) value))
-
- ((string= name "gpr_file")
- ;; The gpr file is parsed in `wisi-compiler-parse-final' below, so
- ;; it sees all file environment vars. We store the absolute gpr
- ;; file name, so we can get the correct default-directory from
- ;; it. Note that gprbuild requires the base name be found on
- ;; GPR_PROJECT_PATH.
- (let* ((process-environment
- (append
- (wisi-prj-compile-env project)
- (wisi-prj-file-env project)));; reference, for
substitute-in-file-name
- (gpr-file (substitute-env-vars value)))
-
- (if (= (aref gpr-file 0) ?$)
- ;; An environment variable that was not resolved, possibly
- ;; because the env var is later defined in the project file;
- ;; it may be resoved in `wisi-compiler-parse-final'.
- (setf (gnat-compiler-gpr-file compiler) gpr-file)
-
- ;; else get the absolute path
- (setf (gnat-compiler-gpr-file compiler)
- (or (locate-file gpr-file (gnat-compiler-project-path compiler))
- (expand-file-name (substitute-env-vars gpr-file))))))
- t)
-
- ((string= name "runtime")
- (setf (gnat-compiler-runtime compiler) value))
-
- ((string= name "target")
- (setf (gnat-compiler-target compiler) value))
-
- ))
-
-(cl-defmethod wisi-compiler-parse-final ((compiler gnat-compiler) project
prj-file-name)
- (setf (gnat-compiler-run-buffer-name compiler) (gnat-run-buffer-name
prj-file-name))
-
- (let ((gpr-file (gnat-compiler-gpr-file compiler)))
- (if gpr-file
- (progn
- (when (= (aref gpr-file 0) ?$)
- ;; An environment variable that was not resolved earlier,
- ;; because the env var is defined in the project file.
- (let ((process-environment
- (append
- (wisi-prj-compile-env project)
- (wisi-prj-file-env project))));; reference, for
substitute-in-file-name
-
- (setq gpr-file
- (or
- (locate-file (substitute-env-vars gpr-file)
- (gnat-compiler-project-path compiler))
- (expand-file-name (substitute-env-vars gpr-file))))
-
- (setf (gnat-compiler-gpr-file compiler) gpr-file)))
-
- (gnat-parse-gpr gpr-file project compiler)
- )
-
- ;; else add the compiler libraries to project.source-path
- (gnat-get-paths project compiler)
- )))
-
-(cl-defmethod wisi-compiler-select-prj ((_compiler gnat-compiler) _project)
- (add-to-list 'completion-ignored-extensions ".ali") ;; gnat library files
- (setq compilation-error-regexp-alist
- ;; gnu matches the summary line from make:
- ;; make: *** [rules.make:143: wisitoken-bnf-generate.exe] Error 4
- ;; which is just annoying, but should be up to the user.
- '(gnu)
- )
- )
-
-(cl-defmethod wisi-compiler-deselect-prj ((_compiler gnat-compiler) _project)
- (setq completion-ignored-extensions (delete ".ali"
completion-ignored-extensions))
- (setq compilation-error-regexp-alist (mapcar #'car
compilation-error-regexp-alist-alist))
- )
-
-(cl-defmethod wisi-compiler-show-prj-path ((compiler gnat-compiler))
- (if (gnat-compiler-project-path compiler)
- (progn
- (pop-to-buffer (get-buffer-create "*project file search path*"))
- (erase-buffer)
- (dolist (file (gnat-compiler-project-path compiler))
- (insert (format "%s\n" file))))
- (message "no project file search path set")
- ))
-
-;;;; gnatprep utils
-
-(defun gnatprep-indent ()
- "If point is on a gnatprep keyword, return indentation column
-for it. Otherwise return nil. Intended to be added to
-`wisi-indent-calculate-functions' or other indentation function
-list."
- ;; gnatprep keywords are:
- ;;
- ;; #if identifier [then]
- ;; #elsif identifier [then]
- ;; #else
- ;; #end if;
- ;;
- ;; they are all indented at column 0.
- (when (equal (char-after) ?\#) 0))
-
-(defun gnatprep-syntax-propertize (start end)
- (goto-char start)
- (save-match-data
- (while (re-search-forward
- "^[ \t]*\\(#\\(?:if\\|else\\|elsif\\|end\\)\\)"; gnatprep keywords.
- end t)
- (cond
- ((match-beginning 1)
- (put-text-property
- (match-beginning 1) (match-end 1) 'syntax-table '(11 . ?\n)))
- )
- )))
-
-(defconst gnatprep-preprocessor-keywords
- (list (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-preprocessor-face t))))
-
-;; We assume that if this file is loaded, any ada-mode buffer may have
-;; gnatprep syntax; even with different host/target compilers, both
-;; must run gnatprep first. If support for another preprocessor is
-;; added, we'll need wisi-prj-preprocessor, along with -compiler and
-;; -xref.
-(defun gnatprep-setup ()
- (add-to-list 'wisi-indent-calculate-functions 'gnatprep-indent)
- (add-hook 'ada-syntax-propertize-hook #'gnatprep-syntax-propertize)
- (font-lock-add-keywords 'ada-mode gnatprep-preprocessor-keywords)
- ;; ada-mode calls font-lock-refresh-defaults after ada-mode-hook
- )
-
-(add-hook 'ada-mode-hook #'gnatprep-setup)
-
-;;;; Initialization
-
-;; These are shared between ada-compiler-gnat and gpr-query.
-(add-to-list 'wisi-prj-file-extensions "gpr")
-(add-to-list 'wisi-prj-parser-alist '("gpr" . gnat-parse-gpr-1))
-
-(add-to-list
- 'compilation-error-regexp-alist-alist
- '(gnat
- ;; typical:
- ;; cards_package.adb:45:32: expected private type "System.Address"
- ;;
- ;; with full path Source_Reference pragma :
- ;; d:/maphds/version_x/1773/sbs-abi-dll_lib.ads.gp:39:06: file
"interfaces_c.ads" not found
- ;;
- ;; gnu cc1: (gnatmake can invoke the C compiler)
- ;; foo.c:2: `TRUE' undeclared here (not in a function)
- ;; foo.c:2 : `TRUE' undeclared here (not in a function)
- ;;
- ;; we can't handle secondary errors here, because a regexp can't
distinquish "message" from "filename"
- "^\\(\\(.:\\)?[^ :\n]+\\):\\([0-9]+\\)\\s-?:?\\([0-9]+\\)?" 1 3 4))
-
-(provide 'gnat-core)
-;; end of file