[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/wisi 5becb56 29/35: Release ada-mode 7.0.1, wisi 3.0.1
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/wisi 5becb56 29/35: Release ada-mode 7.0.1, wisi 3.0.1 |
|
Date: |
Sat, 28 Nov 2020 14:47:57 -0500 (EST) |
branch: externals/wisi
commit 5becb56e9e3c40eb1ed9d94780a1984357cf6651
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>
Release ada-mode 7.0.1, wisi 3.0.1
---
NEWS | 28 +-
README | 9 +-
build-wisitoken-bnf-generate.sh | 2 +-
emacs_wisi_common_parse.adb | 8 +-
emacs_wisi_common_parse.ads | 5 +-
recover_stats.adb | 277 +++++
run_wisi_common_parse.adb | 8 +-
wisi-fringe.el | 302 ++---
wisi-parse-common.el | 7 +-
wisi-prj.el | 1466 +++++++++++++++++++++++
wisi-process-parse.el | 18 +-
wisi-run-indent-test.el | 67 +-
wisi-skel.el | 154 +++
wisi.adb | 94 +-
wisi.ads | 65 +-
wisi.el | 456 ++++---
wisi.gpr => wisi.gpr.gp | 7 +-
wisitoken-bnf-generate.adb | 2 +-
wisitoken-bnf-output_ada_common.adb | 32 +-
wisitoken-parse-lr-mckenzie_recover-explore.adb | 12 +-
wisitoken-parse-lr-mckenzie_recover.adb | 43 +-
wisitoken-parse-lr-mckenzie_recover.ads | 15 +-
wisitoken-parse-lr-parser.adb | 21 +-
wisitoken-parse-lr-parser.ads | 2 +
wisitoken-parse-lr.ads | 3 +-
wisitoken-parse.adb | 9 +-
wisitoken-parse.ads | 17 +-
wisitoken-semantic_checks.ads | 3 +-
wisitoken_grammar_re2c.c | 186 +--
29 files changed, 2770 insertions(+), 548 deletions(-)
diff --git a/NEWS b/NEWS
index 8986e40..277c1ea 100644
--- a/NEWS
+++ b/NEWS
@@ -1,14 +1,38 @@
GNU Emacs wisi NEWS -- history of user-visible changes.
-Copyright (C) 2019 Free Software Foundation, Inc.
+Copyright (C) 2014 - 2020 Free Software Foundation, Inc.
Please send wisi bug reports to bug-gnu-emacs@gnu.org, with
'wisi' in the subject. If possible, use M-x report-emacs-bug.
+* wisi 3.0.1
+30 Jan 2020
+
+** fix packaging bugs
+
+** improve xref integration
+
+* wisi 3.0.0
+19 Dec 2019
+
+** parser process protocol version 5
+
+** Add project.el integration. See wisi.info for more information.
+
+** Move autocase functions from ada-mode to wisi.
+
+** Replace most ada-mode function variables with dispatching on wisi-prj.
+
+** New commands `wisi-goto-containing-statement-start',
`wisi-indent-containing-statement'.
+
+** Displayed parser errors are sorted in increasing error position.
+
* wisi 2.2.1
17 Aug 2019
+** parser process protocol version 4
+
** fix packaging bugs
* wisi 2.2.0
@@ -49,8 +73,6 @@ Please send wisi bug reports to bug-gnu-emacs@gnu.org, with
first one found is included in the current right hand side motion
token chain.
-** The elisp parser and lexer are deleted.
-
** The process parser supports a new parse command `wisi-refactor',
which returns a new message "Edit". It is intended for performing
syntax-guided refactoring of code statements.
diff --git a/README b/README
index f23d1d8..f2c5329 100644
--- a/README
+++ b/README
@@ -1,8 +1,9 @@
-Emacs wisi package 2.2.1
+Emacs wisi package 3.0.1
-The wisi package provides utilities for using generalized LALR parsers
-(in elisp or external processes) to do indentation, fontification, and
-navigation. See ada-mode for an example of its use.
+The wisi package provides utilities for using generalized
+error-correcting LR parsers (in external processes) to do indentation,
+fontification, and navigation; and integration with Emacs package.el.
+See ada-mode for an example of its use.
It also provides wisitoken-parse_table-mode, for navigating the
diagnostic parse tables output by wisitoken-bnf-generate.
diff --git a/build-wisitoken-bnf-generate.sh b/build-wisitoken-bnf-generate.sh
index 0732e5a..faa4094 100755
--- a/build-wisitoken-bnf-generate.sh
+++ b/build-wisitoken-bnf-generate.sh
@@ -4,4 +4,4 @@
# wisitoken development tree; see
# http://stephe-leake.org/ada/wisitoken.html
-gprbuild -p -P wisi.gpr wisitoken-bnf-generate
+gprbuild -p -j8 -P wisi.gpr wisitoken-bnf-generate
diff --git a/emacs_wisi_common_parse.adb b/emacs_wisi_common_parse.adb
index f74ce37..183aaf7 100644
--- a/emacs_wisi_common_parse.adb
+++ b/emacs_wisi_common_parse.adb
@@ -210,6 +210,7 @@ package body Emacs_Wisi_Common_Parse is
Result.Parse_Begin_Char_Pos := WisiToken.Buffer_Pos (Get_Integer
(Command_Line, Last));
Result.Parse_Begin_Line := WisiToken.Line_Number_Type
(Get_Integer (Command_Line, Last));
Result.Parse_End_Line := WisiToken.Line_Number_Type
(Get_Integer (Command_Line, Last));
+ Result.Parse_Begin_Indent := Get_Integer (Command_Line, Last);
Result.Debug_Mode := 1 = Get_Integer (Command_Line, Last);
Result.Parse_Verbosity := Get_Integer (Command_Line, Last);
Result.Action_Verbosity := Get_Integer (Command_Line, Last);
@@ -309,7 +310,8 @@ package body Emacs_Wisi_Common_Parse is
Trace_Action := Params.Action_Verbosity;
Debug_Mode := Params.Debug_Mode;
- Partial_Parse_Active := Params.Partial_Parse_Active;
+ Partial_Parse_Active := Params.Partial_Parse_Active;
+ Parser.Partial_Parse_Active := Params.Partial_Parse_Active;
if WisiToken.Parse.LR.McKenzie_Defaulted (Parser.Table.all)
then
-- There is no McKenzie information; don't override that.
@@ -351,6 +353,8 @@ package body Emacs_Wisi_Common_Parse is
Parser.Lexer.Reset_With_String_Access
(Buffer, Params.Source_File_Name, Params.Begin_Char_Pos,
Params.Begin_Line);
+
+ -- Parser.Line_Begin_Token First, Last set by Lex_All
begin
Parser.Parse;
exception
@@ -413,7 +417,7 @@ package body Emacs_Wisi_Common_Parse is
Base_Terminals => Parser.Terminals'Unrestricted_Access,
Begin_Line => Params.Parse_Begin_Line,
End_Line => Params.Parse_End_Line,
- Begin_Indent => 0,
+ Begin_Indent => Params.Parse_Begin_Indent,
Params => "");
if Params.Max_Parallel > 0 then
diff --git a/emacs_wisi_common_parse.ads b/emacs_wisi_common_parse.ads
index 1d75de6..e646eba 100644
--- a/emacs_wisi_common_parse.ads
+++ b/emacs_wisi_common_parse.ads
@@ -24,7 +24,7 @@ with Wisi;
with WisiToken.Parse.LR.Parser;
package Emacs_Wisi_Common_Parse is
- Protocol_Version : constant String := "4";
+ Protocol_Version : constant String := "5";
-- Protocol_Version defines the data sent between elisp and the
-- background process, except for the language-specific parameters,
-- which are defined by the Language_Protocol_Version parameter to
@@ -141,6 +141,9 @@ package Emacs_Wisi_Common_Parse is
Parse_End_Line : WisiToken.Line_Number_Type;
-- Line numbers of lines containing Parse_Begin_Byte_Pos,
Parse_End_Byte_Pos
+ Parse_Begin_Indent : Integer;
+ -- Indentation of Parse_Begin_Line
+
Debug_Mode : Boolean;
Parse_Verbosity : Integer;
Action_Verbosity : Integer;
diff --git a/recover_stats.adb b/recover_stats.adb
new file mode 100644
index 0000000..9172cb8
--- /dev/null
+++ b/recover_stats.adb
@@ -0,0 +1,277 @@
+-- Abstract :
+--
+-- Summarize error recover log.
+--
+-- Copyright (C) 2019 Stephen Leake 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.Long_Float_Text_IO;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+with Ada.Strings.Maps;
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Traceback.Symbolic;
+with SAL.Gen_Stats.Gen_Image;
+with SAL.Long_Float_Stats;
+with WisiToken.Parse.LR;
+procedure Recover_Stats
+is
+ subtype Strategies is WisiToken.Parse.LR.Strategies;
+
+ File : File_Type;
+
+ Delimiters : constant Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps.To_Set (",() ");
+ Number : constant Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps.To_Set ("0123456789");
+
+ type Strategy_Counts is array (Strategies) of Natural;
+
+ type Recover_Label is (Full, Partial);
+
+ type Recover_Summary is record
+ Event_Count : Integer := 0;
+ -- 1 per recover event (1 line in log file)
+
+ Enqueue_Stats : SAL.Long_Float_Stats.Stats_Type;
+ Check_Stats : SAL.Long_Float_Stats.Stats_Type;
+
+ Strat_Counts_Total : Strategy_Counts := (others => 0);
+ Strat_Counts_Present : Strategy_Counts := (others => 0);
+ -- 1 per recover event if used
+
+ Ignore_Error : Integer := 0;
+ -- ie, error is name mismatch.
+
+ Recover_Count_Present : Integer := 0;
+ -- 1 per parser in recover result
+
+ Recover_Count_Total : Integer := 0;
+ -- Sum of all strategy counts
+
+ Fail_Event_Count : Integer := 0; -- for all reasons
+ Fail_Enqueue_Limit : Integer := 0;
+ Fail_No_Configs_Left : Integer := 0;
+ Fail_Programmer_Error : Integer := 0;
+ Fail_Other : Integer := 0;
+ end record;
+
+ Summary : array (Recover_Label) of Recover_Summary;
+begin
+ Open (File, In_File, Ada.Command_Line.Argument (1));
+
+ loop
+ exit when End_Of_File (File);
+ declare
+ -- The recover log is written by code in
+ -- wisitoken-parse-lr-parser.adb Parse (search for Recover_Log).
+ --
+ -- A line has the syntax:
+ -- yyyy-mm-dd hh:mm:ss <partial> <success> pre_parser_count
'<file_name>' (<parser_data>)...
+ --
+ -- where there is one (<parser_data) for each parser active after
recover. <parser_data> is:
+ --
+ -- (<strategy_counts>) <enqueue_count> <check_count> <success>
+ --
+ -- Note that the per-parser success is always TRUE; it would not be
+ -- active if recover had failed.
+
+ Line : constant String := Get_Line (File);
+ First : Integer := Index (Line, " "); -- after date
+ Last : Integer;
+
+ Label : Recover_Label := Full;
+
+ function Line_Eq (Item : in String) return Boolean
+ is begin
+ return Line (First .. First + Item'Length - 1) = Item;
+ end Line_Eq;
+
+ function Next_Integer return Integer
+ is begin
+ Find_Token
+ (Line, Number,
+ From => Last + 1,
+ Test => Ada.Strings.Inside,
+ First => First,
+ Last => Last);
+ return Integer'Value (Line (First .. Last));
+ exception
+ when Constraint_Error =>
+ raise Constraint_Error with "bad integer '" & Line (First .. Last
- 1) & "' " &
+ Ada.Text_IO.Count'Image (Ada.Text_IO.Line (File) - 1) &
First'Image & Last'Image;
+ end Next_Integer;
+
+ function Next_Boolean return Boolean
+ is begin
+ First := Last + 2;
+ Last := -1 + Index (Line, Delimiters, First);
+ return Boolean'Value (Line (First .. Last));
+ end Next_Boolean;
+
+ function Read_Strat_Counts (Strategy_Found : out Boolean) return
Strategy_Counts
+ is begin
+ Strategy_Found := False;
+ Last := Index (Line, "(", Last + 1);
+ return Result : Strategy_Counts do
+ for I in Strategies loop
+ Result (I) := Next_Integer;
+ if Result (I) > 0 then
+ Strategy_Found := True;
+ end if;
+ end loop;
+ Last := 1 + Index (Line, ")", Last + 1);
+ end return;
+ end Read_Strat_Counts;
+
+ begin
+ First := Index (Line, " ", First + 1); -- after time
+ Last := Index (Line, " ", First + 1); -- after Partial_Parse_Active
+ if Boolean'Value (Line (First + 1 .. Last - 1)) then
+ Label := Partial;
+ end if;
+
+ Summary (Label).Event_Count := Summary (Label).Event_Count + 1;
+
+ First := Last + 1;
+ if Line (First .. First + 3) = "FAIL" then
+ Summary (Label).Fail_Event_Count := Summary
(Label).Fail_Event_Count + 1;
+ First := First + 4;
+
+ if Line_Eq ("NO_CONFIGS_LEFT") then
+ Summary (Label).Fail_No_Configs_Left := Summary
(Label).Fail_No_Configs_Left + 1;
+ elsif Line_Eq ("ENQUEUE_LIMIT") then
+ Summary (Label).Fail_Enqueue_Limit := Summary
(Label).Fail_Enqueue_Limit + 1;
+ elsif Line_Eq ("PROGRAMMER_ERROR") then
+ Summary (Label).Fail_Programmer_Error := Summary
(Label).Fail_Programmer_Error + 1;
+ else
+ Summary (Label).Fail_Other := Summary (Label).Fail_Other + 1;
+ end if;
+
+ else
+ -- Process per-parser data
+ Last := Index (Line, "(", Last + 1);
+ loop
+ exit when Line (Last + 1) = ')';
+ declare
+ Strategy_Found : Boolean;
+ Strat_Counts : constant Strategy_Counts :=
Read_Strat_Counts (Strategy_Found);
+ Enqueue_Count : constant Integer := Next_Integer;
+ Check_Count : constant Integer := Next_Integer;
+ Success : constant Boolean := Next_Boolean;
+ pragma Unreferenced (Success);
+ begin
+ Summary (Label).Recover_Count_Present := Summary
(Label).Recover_Count_Present + 1;
+
+ if not Strategy_Found then
+ Summary (Label).Ignore_Error := Summary
(Label).Ignore_Error + 1;
+ else
+ -- We don't include Ignore_Error enqueue and check
counts in the
+ -- stats, because they distort them towards 1.
+ Summary (Label).Enqueue_Stats.Accumulate (Long_Float
(Enqueue_Count));
+ Summary (Label).Check_Stats.Accumulate (Long_Float
(Check_Count));
+ for I in Strategies loop
+ Summary (Label).Recover_Count_Total :=
+ Summary (Label).Recover_Count_Total + Strat_Counts
(I);
+ Summary (Label).Strat_Counts_Total (I) :=
+ Summary (Label).Strat_Counts_Total (I) +
Strat_Counts (I);
+ if Strat_Counts (I) > 0 then
+ Summary (Label).Strat_Counts_Present (I) := Summary
(Label).Strat_Counts_Present (I) + 1;
+ end if;
+ end loop;
+ end if;
+ end;
+ end loop;
+ end if;
+ end;
+ end loop;
+
+ declare
+ use Ada.Strings;
+
+ Label_Field : String (1 .. 23); -- fits strategy and fail labels
+ Count_Field : String (1 .. 8);
+ Percent_Field : String (1 .. 4);
+ -- Shared by Put_If, Put_Percent
+
+ procedure Put_If
+ (Summary_Label : in Recover_Label;
+ Name : in String;
+ Count : in Integer;
+ Always : in Boolean := False)
+ is
+ Percent_Present : constant Integer :=
+ Integer (100.0 * Float (Count) / Float (Summary
(Summary_Label).Event_Count));
+ begin
+ if Count > 0 or Always then
+ Move (Name, Label_Field); Put (Label_Field & " => ");
+ Move (Count'Image, Count_Field, Justify => Right); Put
(Count_Field);
+ Move (Percent_Present'Image & "%", Percent_Field, Justify =>
Right); Put_Line (Percent_Field);
+ end if;
+ end Put_If;
+
+ package Stats_Image is new SAL.Long_Float_Stats.Gen_Image
+ (Real_IO => Ada.Long_Float_Text_IO,
+ Default_Mean_Fore => 7,
+ Default_Mean_Aft => 0,
+ Default_Mean_Exp => 0,
+ Default_Sd_Fore => 7,
+ Default_Sd_Aft => 1,
+ Default_Sd_Exp => 0);
+
+ procedure Put_Percent (Summary_Label : in Recover_Label; Present, Total
: in Integer; Name : in String)
+ is
+ Percent_Present : constant Integer :=
+ Integer (100.0 * Float (Present) / Float (Summary
(Summary_Label).Recover_Count_Present));
+ Percent_Total : constant Integer :=
+ Integer (100.0 * Float (Total) / Float (Summary
(Summary_Label).Recover_Count_Total));
+ begin
+ Move (Name, Label_Field); Put (Label_Field);
+ Move (Present'Image, Count_Field, Justify => Right); Put
(Count_Field);
+ Move (Percent_Present'Image & "%", Percent_Field, Justify => Right);
Put (Percent_Field & " /");
+ Move (Total'Image, Count_Field, Justify => Right); Put (Count_Field);
+ Move (Percent_Total'Image & "%", Percent_Field, Justify => Right);
Put_Line (Percent_Field);
+ end Put_Percent;
+
+ begin
+ for I in Recover_Label loop
+ Put_Line (I'Image);
+ Put_Line ("present/total:" & Summary (I).Event_Count'Image & " /" &
Summary (I).Recover_Count_Total'Image);
+ if Summary (I).Event_Count > 0 then
+ Put_Line (" mean std. dev. min max");
+ Put_Line ("Enqueue: " & Stats_Image.Image (Summary
(I).Enqueue_Stats.Display));
+ Put_Line ("Check: " & Stats_Image.Image (Summary
(I).Check_Stats.Display));
+ Put_If (I, "FAIL", Summary (I).Fail_Event_Count, Always => True);
+ Put_If (I, "FAIL_ENQUEUE_LIMIT", Summary (I).Fail_Enqueue_Limit);
+ Put_If (I, "FAIL_NO_CONFIGS_LEFT", Summary
(I).Fail_No_Configs_Left);
+ Put_If (I, "FAIL_PROGRAMMER_ERROR", Summary
(I).Fail_Programmer_Error);
+ Put_If (I, "FAIL_OTHER", Summary (I).Fail_Other);
+ for J in Strategies loop
+ Put_Percent
+ (I,
+ Summary (I).Strat_Counts_Present (J),
+ Summary (I).Strat_Counts_Total (J),
+ J'Image);
+ end loop;
+ Put_Percent (I, Summary (I).Ignore_Error, Summary
(I).Ignore_Error, "Ignore_Error");
+ end if;
+ New_Line;
+ end loop;
+ end;
+exception
+when E : others =>
+ Put_Line (Ada.Exceptions.Exception_Name (E) & ": " &
Ada.Exceptions.Exception_Message (E));
+ Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
+end Recover_Stats;
diff --git a/run_wisi_common_parse.adb b/run_wisi_common_parse.adb
index e4a45c0..517b631 100644
--- a/run_wisi_common_parse.adb
+++ b/run_wisi_common_parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 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
@@ -45,7 +45,7 @@ package body Run_Wisi_Common_Parse is
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 (" 4 - add lexer debug, dump syntax tree");
Put_Line ("--check_limit n : set error recover token check limit" &
(if Parser.Table = null then ""
else "; default" &
Parser.Table.McKenzie_Param.Check_Limit'Image));
@@ -218,10 +218,12 @@ package body Run_Wisi_Common_Parse is
return;
end;
+ -- Parser.Line_Begin_Token First, Last set by Lex_All
+
if Cl_Params.Command = Refactor or else Cl_Params.End_Line =
Invalid_Line_Number then
-- User did not provide; run lexer to get end line.
declare
- Token : Base_Token;
+ Token : Base_Token;
Lexer_Error : Boolean;
pragma Unreferenced (Lexer_Error);
begin
diff --git a/wisi-fringe.el b/wisi-fringe.el
index 82f4c6a..2194b09 100644
--- a/wisi-fringe.el
+++ b/wisi-fringe.el
@@ -1,150 +1,152 @@
-;;; wisi-fringe.el --- show approximate error locations in the fringe
-;;
-;; Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
-;;
-;; 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/>.
-;;
-;; Design:
-;;
-;; Bitmaps are displayed in the fringe by putting a 'display property
-;; on buffer text. However, just doing that also hides the buffer
-;; text. To avoid that, we put the ’display property on a string, and
-;; then an overlay containing that string as ’before-string or
-;; ’after-string on the newline of a buffer line.
-;;
-;; We show approximate error positions in the entire buffer with
-;; single-pixel lines in the right fringe, and mark error lines with
-;; ’!!’ in the left fringe.
-
-(defun wisi-fringe-create-bitmaps ()
- "Return an array of bitmap symbols containing the fringe bitmaps."
- ;; First create the ’!!’ bitmap.
- (define-fringe-bitmap 'wisi-fringe--double-exclaim-bmp
- (vector
- #b00000000
- #b01100110
- #b01100110
- #b01100110
- #b01100110
- #b01100110
- #b00000000
- #b01100110
- #b01010110
- #b00000000))
-
- ;; In condensing the entire buffer to the current window height, we
- ;; assume a 10 point font, which allows 6 distinct line positions
- ;; each one pixel high, with one blank pixel between.
-
- (let ((result (make-vector 64 nil))
- (i 1))
- (while (<= i (length result))
- (aset result (1- i)
- (define-fringe-bitmap (intern (format "wisi-fringe--line-%d-bmp" i))
- (vector
- (if (>= i 32) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 32) 16) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 16) 8) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 8) 4) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 4) 2) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 2) 1) #b11111111 #b00000000)
- )))
- (setq i (1+ i)))
- result))
-
-(defconst wisi-fringe-bitmaps (wisi-fringe-create-bitmaps)
- "Array of 64 bitmap symbols.")
-
-(defun wisi-fringe--put-right (line bitmap-index)
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (let* ((endpos (line-end-position))
- (ov (make-overlay endpos (1+ endpos)))
- (bmp (aref wisi-fringe-bitmaps bitmap-index)))
- (overlay-put ov 'after-string (propertize "-" 'display (list
'right-fringe bmp 'compilation-error)))
- (overlay-put ov 'wisi-fringe t)
- )))
-
-(defun wisi-fringe--put-left (line)
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (let* ((endpos (line-end-position))
- (ov (make-overlay endpos (1+ endpos)))
- (bmp 'wisi-fringe--double-exclaim-bmp))
- (overlay-put ov 'before-string (propertize "-" 'display (list
'left-fringe bmp 'compilation-error)))
- (overlay-put ov 'wisi-fringe t)
- )))
-
-(defun wisi-fringe--scale (error-line buffer-lines window-line-first
window-lines)
- "Return a cons (LINE . BIN) for ERROR-LINE,
-where LINE is the line to display the error bar on, and BIN is a
-6-bit bit vector giving the relative position in that line.
-BUFFER-LINES is the count of lines in the buffer.
-WINDOW-LINE-FIRST is the first and last lines of the buffer
-visible in the window. WINDOW-LINES is the count of lines visible
-in the window."
- ;; If the end of buffer is inside the window, and this calculation
- ;; puts a mark after that, it will actually be put on the last real
- ;; line. That’s good enough for our purposes.
-
- ;; partial-lines / window-line = 6
- ;; buffer-lines / window-line = 1/scale
- ;; buffer-lines / partial-line = (window-line / partial-lines) *
(buffer-lines / window-line) = 1/6 * 1/scale
- (let* ((scale (/ window-lines (float buffer-lines)))
- (line (floor (* scale error-line)))
- (rem (- error-line (floor (/ line scale)))))
- (cons (+ window-line-first line) (lsh 1 (min 5 (floor (* rem (* 6
scale))))))))
-
-(defun wisi-fringe-clean ()
- "Remove all wisi-fringe marks."
- (remove-overlays (point-min) (point-max) 'wisi-fringe t))
-
-(defun wisi-fringe-display-errors (positions)
- "Display markers in the left and right fringe for each buffer position in
POSITIONS.
-The buffer containing POSITIONS must be current, and the window
-displaying that buffer must be current."
- ;; FIXME: recompute fringe display on scroll!
- (wisi-fringe-clean)
- (let (scaled-posns
- (buffer-lines (line-number-at-pos (point-max)))
- (window-lines (window-height))
- (window-pos-first (window-start))
- (window-pos-last (window-end))
- (window-line-first (line-number-at-pos (window-start))))
- (dolist (pos positions)
- (let* ((line (line-number-at-pos pos))
- (scaled-pos (wisi-fringe--scale line buffer-lines
window-line-first window-lines)))
- (when (and (>= pos window-pos-first)
- (<= pos window-pos-last))
- (wisi-fringe--put-left line))
- (if (and scaled-posns
- (= (caar scaled-posns) (car scaled-pos)))
- (setcdr (car scaled-posns) (logior (cdar scaled-posns) (cdr
scaled-pos)))
- (push scaled-pos scaled-posns))
- ))
-
- (dolist (pos scaled-posns)
- (wisi-fringe--put-right (car pos) (1- (cdr pos))))
- ))
-
-(provide 'wisi-fringe)
+;;; wisi-fringe.el --- show approximate error locations in the fringe
+;;
+;; Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+;;
+;; 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/>.
+;;
+;; Design:
+;;
+;; Bitmaps are displayed in the fringe by putting a 'display property
+;; on buffer text. However, just doing that also hides the buffer
+;; text. To avoid that, we put the ’display property on a string, and
+;; then an overlay containing that string as ’before-string or
+;; ’after-string on the newline of a buffer line.
+;;
+;; We show approximate error positions in the entire buffer with
+;; single-pixel lines in the right fringe, and mark error lines with
+;; ’!!’ in the left fringe.
+
+(defun wisi-fringe-create-bitmaps ()
+ "Return an array of bitmap symbols containing the fringe bitmaps."
+ ;; First create the ’!!’ bitmap.
+ (define-fringe-bitmap 'wisi-fringe--double-exclaim-bmp
+ (vector
+ #b00000000
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b00000000
+ #b01100110
+ #b01010110
+ #b00000000))
+
+ ;; In condensing the entire buffer to the current window height, we
+ ;; assume a 10 point font, which allows 6 distinct line positions
+ ;; each one pixel high, with one blank pixel between.
+
+ (let ((result (make-vector 64 nil))
+ (i 1))
+ (while (<= i (length result))
+ (aset result (1- i)
+ (define-fringe-bitmap (intern (format "wisi-fringe--line-%d-bmp" i))
+ (vector
+ (if (>= i 32) #b11111111 #b00000000)
+ #b00000000
+ (if (>= (% i 32) 16) #b11111111 #b00000000)
+ #b00000000
+ (if (>= (% i 16) 8) #b11111111 #b00000000)
+ #b00000000
+ (if (>= (% i 8) 4) #b11111111 #b00000000)
+ #b00000000
+ (if (>= (% i 4) 2) #b11111111 #b00000000)
+ #b00000000
+ (if (>= (% i 2) 1) #b11111111 #b00000000)
+ )))
+ (setq i (1+ i)))
+ result))
+
+(defconst wisi-fringe-bitmaps (wisi-fringe-create-bitmaps)
+ "Array of 64 bitmap symbols.")
+
+(defun wisi-fringe--put-right (line bitmap-index)
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (let* ((endpos (line-end-position))
+ (ov (make-overlay endpos (1+ endpos)))
+ (bmp (aref wisi-fringe-bitmaps bitmap-index)))
+ (overlay-put ov 'after-string (propertize "-" 'display (list
'right-fringe bmp 'compilation-error)))
+ (overlay-put ov 'wisi-fringe t)
+ )))
+
+(defun wisi-fringe--put-left (line)
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (let* ((endpos (line-end-position))
+ (ov (make-overlay endpos (1+ endpos)))
+ (bmp 'wisi-fringe--double-exclaim-bmp))
+ (overlay-put ov 'before-string (propertize "-" 'display (list
'left-fringe bmp 'compilation-error)))
+ (overlay-put ov 'wisi-fringe t)
+ )))
+
+(defun wisi-fringe--scale (error-line buffer-lines window-line-first
window-lines)
+ "Return a cons (LINE . BIN) for ERROR-LINE,
+where LINE is the line to display the error bar on, and BIN is a
+6-bit bit vector giving the relative position in that line.
+BUFFER-LINES is the count of lines in the buffer.
+WINDOW-LINE-FIRST is the first and last lines of the buffer
+visible in the window. WINDOW-LINES is the count of lines visible
+in the window."
+ ;; If the end of buffer is inside the window, and this calculation
+ ;; puts a mark after that, it will actually be put on the last real
+ ;; line. That’s good enough for our purposes.
+
+ ;; partial-lines / window-line = 6
+ ;; buffer-lines / window-line = 1/scale
+ ;; buffer-lines / partial-line = (window-line / partial-lines) *
(buffer-lines / window-line) = 1/6 * 1/scale
+ (let* ((scale (/ window-lines (float buffer-lines)))
+ (line (floor (* scale error-line)))
+ (rem (- error-line (floor (/ line scale)))))
+ (cons (+ window-line-first line) (lsh 1 (min 5 (floor (* rem (* 6
scale))))))))
+
+(defun wisi-fringe-clean ()
+ "Remove all wisi-fringe marks."
+ (remove-overlays (point-min) (point-max) 'wisi-fringe t))
+
+(defun wisi-fringe-display-errors (positions)
+ "Display markers in the left and right fringe for each buffer position in
POSITIONS.
+The buffer containing POSITIONS must be current, and the window
+displaying that buffer must be current."
+ ;; We don't recompute fringe display on scroll, because the user
+ ;; will probably have edited the code by then, triggering a new
+ ;; parse.
+ (wisi-fringe-clean)
+ (let (scaled-posns
+ (buffer-lines (line-number-at-pos (point-max)))
+ (window-lines (window-height))
+ (window-pos-first (window-start))
+ (window-pos-last (window-end))
+ (window-line-first (line-number-at-pos (window-start))))
+ (dolist (pos positions)
+ (let* ((line (line-number-at-pos pos))
+ (scaled-pos (wisi-fringe--scale line buffer-lines
window-line-first window-lines)))
+ (when (and (>= pos window-pos-first)
+ (<= pos window-pos-last))
+ (wisi-fringe--put-left line))
+ (if (and scaled-posns
+ (= (caar scaled-posns) (car scaled-pos)))
+ (setcdr (car scaled-posns) (logior (cdar scaled-posns) (cdr
scaled-pos)))
+ (push scaled-pos scaled-posns))
+ ))
+
+ (dolist (pos scaled-posns)
+ (wisi-fringe--put-right (car pos) (1- (cdr pos))))
+ ))
+
+(provide 'wisi-fringe)
diff --git a/wisi-parse-common.el b/wisi-parse-common.el
index dd9d862..2140b50 100644
--- a/wisi-parse-common.el
+++ b/wisi-parse-common.el
@@ -1,4 +1,4 @@
-;;; wisi-parse-common.el --- declarations used by wisi-parse.el,
wisi-ada-parse.el, and wisi.el
+;;; wisi-parse-common.el --- declarations used by wisi-parse.el,
wisi-ada-parse.el, and wisi.el -*- lexical-binding:t -*-
;;
;; Copyright (C) 2014, 2015, 2017 - 2019 Free Software Foundation, Inc.
;;
@@ -74,10 +74,9 @@ and parse the whole buffer."
(cl-defgeneric wisi-parse-format-language-options ((parser wisi-parser))
"Return a string to be sent to the parser, containing settings
for the language-specific parser options."
- ;; not needed for the elisp parser, which can see the options directly.
)
-(cl-defgeneric wisi-parse-expand-region ((parser wisi-parser) begin end)
+(cl-defgeneric wisi-parse-expand-region ((_parser wisi-parser) begin end)
"Return a cons SEND-BEGIN . SEND-END that is an expansion of
region BEGIN END that starts and ends at points the parser can
handle gracefully."
@@ -119,7 +118,7 @@ Return nil if no match found before eob."
(goto-char (cdr region))
))
-(cl-defgeneric wisi-parse-adjust-indent ((parser wisi-parser) indent _repair)
+(cl-defgeneric wisi-parse-adjust-indent ((_parser wisi-parser) indent _repair)
"Adjust INDENT for REPAIR (a wisi--parse-error-repair struct). Return new
indent."
indent)
diff --git a/wisi-prj.el b/wisi-prj.el
new file mode 100644
index 0000000..833a514
--- /dev/null
+++ b/wisi-prj.el
@@ -0,0 +1,1466 @@
+;;; wisi-prj.el --- project definition files -*- lexical-binding:t -*-
+;;
+;; Copyright (C) 2019 - 2020 Free Software Foundation, Inc.
+;;
+;; Author: 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/>.
+
+;;; Usage:
+;;
+;; See wisi.info (compiled from wisi.texi).
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'find-file)
+(require 'wisi)
+
+(cl-defstruct wisi-prj
+ name ;; A user-friendly string, used in menus and messages.
+
+ compile-env
+ ;; List of strings NAME=VALUE for `compilation-environment'; used
+ ;; when running the compiler or makefile. Also prepended to
+ ;; `process-environment' when the project file is parsed, or when
+ ;; the project file is used by a tool in an external process.
+
+ file-env
+ ;; Environment (list of strings NAME=VALUE) set in project file;
+ ;; prepended to `process-environment' running tools in an external
+ ;; process.
+
+ compiler
+ xref
+ ;; xref functionality is often provided by the compiler. We allow
+ ;; for separate compiler and xref objects, to handle the case where
+ ;; the compiler is a cross-compiler for an embedded target, and xref
+ ;; is provided by a host compiler.
+
+ (case-exception-files nil)
+ ;; List of casing exception files; from `casing' project variable.
+ ;;
+ ;; New exceptions may be added interactively via
+ ;; `wisi-case-create-exception'. If an exception is defined in
+ ;; multiple files, the first occurence is used.
+ ;;
+ ;; The file format is one word per line, which gives the casing to be
+ ;; used for that word in source code. If the line starts with
+ ;; the character *, then the exception will be used for partial
+ ;; words that either start at the beginning of a word or after a _
+ ;; character, and end either at the end of the word or at a _
+ ;; character. Characters after the first word are ignored, and not
+ ;; preserved when the list is written back to the file."
+
+ (case-full-exceptions '())
+ ;; Alist of full words that have special casing, built from
+ ;; case-exception-files. Indexed by properly cased word; value is t.
+
+ (case-partial-exceptions '())
+ ;; Alist of partial words that have special casing, built from
+ ;; project casing files list partial word exceptions. Indexed by
+ ;; properly cased word; value is t.
+
+ source-path ;; list of absolute directory file names
+
+ file-pred
+ ;; Function taking an absolute file name, returns non-nil
+ ;; if the file should be included in `project-files'.
+ )
+
+(defun wisi-prj-require-prj ()
+ "Return current `wisi-prj' object.
+Throw an error if current project is not an wisi-prj."
+ (let ((prj (project-current)))
+ (if (wisi-prj-p prj)
+ prj
+ (error "current project is not a wisi project."))))
+
+(defun wisi-prj-current-prj ()
+ "Return current `wisi-prj' object.
+If (project-current) does not return a wisi-prj, return a default prj."
+ (let ((prj (project-current)))
+ (if (wisi-prj-p prj)
+ prj
+ (make-wisi-prj :name "default"))))
+
+(defvar wisi-prj-file-extensions (list "prj")
+ "List of wisi project file extensions.
+Used when searching for project files.")
+
+(defvar wisi-prj--cache nil
+ "Alist holding currently parsed project objects.
+Indexed by absolute project file name.")
+
+(cl-defgeneric wisi-prj-default (prj)
+ "Return a project with default values.
+Used to reset a project before refreshing it.")
+
+(cl-defgeneric wisi-prj-parse-one (_project _name _value)
+ "If recognized by PROJECT, set NAME, VALUE in PROJECT, return non-nil.
+Else return nil."
+ nil)
+
+(cl-defgeneric wisi-prj-parse-final (_project _prj-file-name)
+ "Do any final processing on PROJECT
+after the project file PRJ-FILE-NAME is parsed."
+ nil)
+
+(cl-defgeneric wisi-prj-select (project)
+ "PROJECT is selected; perform any required actions.")
+
+(cl-defgeneric wisi-prj-deselect (project)
+ "PROJECT is deselected; undo any select actions.")
+
+(cl-defgeneric wisi-prj-refresh-cache (prj not-full)
+ "Reparse the project file for PRJ, refresh all cached data in PRJ.
+If NOT-FULL is non-nil, very slow refresh operations may be skipped.")
+
+(cl-defgeneric wisi-prj-identifier-ignore-case (prj)
+ "Return non-nil if case should be ignored when comparing identifiers.")
+
+;; We provide nil defaults for some methods, because some language
+;; modes don't have a language-specific compiler (eg java-wisi) or
+;; xref process (eg gpr-mode).
+
+(cl-defgeneric wisi-compiler-parse-one (compiler project name value)
+ "Set NAME, VALUE in COMPILER, if recognized by COMPILER.
+PROJECT is an `wisi-prj' object; COMPILER is `wisi-prj-compiler'.")
+
+(cl-defgeneric wisi-compiler-parse-final (_compiler _project _prj-file-name)
+ "Do any compiler-specific processing on COMPILER and PROJECT
+after the project file PRJ-FILE-NAME is parsed."
+ nil)
+
+(cl-defgeneric wisi-compiler-select-prj (_compiler _project)
+ "PROJECT has been selected; do any compiler-specific actions required."
+ nil)
+
+(cl-defgeneric wisi-compiler-deselect-prj (_compiler _project)
+ "PROJECT has been de-selected; undo any compiler-specific select actions."
+ nil)
+
+(cl-defgeneric wisi-compiler-show-prj-path (compiler)
+ "Display buffer listing project file search path.")
+
+(cl-defgeneric wisi-compiler-fix-error (compiler source-buffer)
+ "Attempt to fix a compilation error, return non-nil if fixed.
+Current buffer is compilation buffer; point is at an error message.
+SOURCE-BUFFER contains the source code referenced in the error message.")
+
+(cl-defgeneric wisi-xref-parse-one (_xref _project _name _value)
+ "If recognized by XREF, set NAME, VALUE in XREF, return non-nil.
+Else return nil."
+ nil)
+
+(cl-defgeneric wisi-xref-parse-final (_xref _project _prj-file-name)
+ "Do any xref-specific processing on XREF and PROJECT
+after the project file PRJ-FILE-NAME is parsed."
+ nil)
+
+(cl-defgeneric wisi-xref-select-prj (_xref _project)
+ "PROJECT has been selected; do any xref-specific actions required."
+ nil)
+
+(cl-defgeneric wisi-xref-deselect-prj (_xref _project)
+ "PROJECT has been de-selected; undo any xref-specific select actions."
+ nil)
+
+(cl-defgeneric wisi-xref-refresh-cache (_xref _project _no-full)
+ "Refresh cached information in XREF. If no-full is non-nil,
+slow refresh operations may be skipped."
+ nil)
+
+(cl-defgeneric wisi-xref-definitions (_xref project item)
+ "Return all definitions (classwide) of ITEM (an xref-item), as a list of
xref-items.")
+
+(cl-defgeneric wisi-xref-references (_xref project item)
+ "Return all references to ITEM (an xref-item), as a list of xref-items.")
+
+(cl-defgeneric wisi-xref-other (project &key identifier filename line column)
+ "Return cross reference information.
+PROJECT - dispatching object, normally a `wisi-prj' object.
+IDENTIFIER - an identifier or operator_symbol
+FILENAME - absolute filename containing the identifier
+LINE - line number containing the identifier (may be nil)
+COLUMN - Emacs column of the start of the identifier (may be nil)
+Point is on the start of the identifier.
+Returns a list (FILE LINE COLUMN) giving the corresponding location;
+FILE is an absolute file name. If point is at the specification, the
+corresponding location is the
+body, and vice versa.")
+
+(defvar-local wisi-xref-full-path nil
+ "If non-nil, xref functions show full paths in results.")
+
+(defun wisi-goto-source (file line column)
+ "Find and select FILE, at LINE and COLUMN.
+FILE may be absolute, or on `compilation-search-path'.
+LINE, COLUMN are Emacs origin."
+ (let ((file-1
+ (if (file-name-absolute-p file) file
+ (ff-get-file-name compilation-search-path file))))
+ (if file-1
+ (setq file file-1)
+ (error "File %s not found; installed library, or set project?" file))
+ )
+
+ (push-mark (point) t)
+
+ (let ((buffer (get-file-buffer file)))
+ (cond
+ ((bufferp buffer)
+ ;; use pop-to-buffer, so package other-frame-window works.
+ (pop-to-buffer buffer (list #'display-buffer-same-window)))
+
+ ((file-exists-p file)
+ (find-file file))
+
+ (t
+ (error "'%s' not found" file))))
+
+ ;; move the cursor to the correct position
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (forward-char column))
+
+(defun wisi-show-xref (xref)
+ "Display XREF location."
+ (let ((marker (xref-location-marker (xref-item-location xref))))
+ (pop-to-buffer (marker-buffer marker) (list #'display-buffer-same-window))
+ (goto-char (marker-position marker))))
+
+(defun wisi-get-identifier (prompt)
+ "Get identifier at point, or if no identifier at point, or with user arg,
prompt for one."
+ ;; Similar to xref--read-identifier, but uses a different completion
+ ;; table, because we want a more specific reference.
+ (let* ((backend (xref-find-backend))
+ (def (xref-backend-identifier-at-point backend)))
+
+ (cond
+ ((or current-prefix-arg
+ (not def))
+ (let ((id
+ (completing-read
+ (if def
+ (format "%s (default %s): " prompt def)
+ prompt)
+ (wisi-names t)
+ nil nil nil
+ 'xref--read-identifier-history def)))
+ (if (equal id "")
+ (user-error "No identifier provided")
+ id)))
+ (t def))))
+
+(defun wisi-goto-spec/body (identifier)
+ "Goto declaration or body for IDENTIFIER (default symbol at point).
+If no symbol at point, or with prefix arg, prompt for symbol, goto spec."
+ (interactive (list (wisi-get-identifier "Goto spec/body of: ")))
+ (let ((prj (project-current)))
+ (wisi-show-xref
+ (wisi-xref-ident-make
+ identifier
+ (lambda (ident file line column)
+ (let ((target (wisi-xref-other
+ (wisi-prj-xref prj) prj
+ :identifier ident
+ :filename file
+ :line line
+ :column column)))
+ (xref-make ident
+ (xref-make-file-location
+ (nth 0 target) ;; file
+ (nth 1 target) ;; line
+ (nth 2 target))) ;; column
+ ))))
+ ))
+
+(cl-defgeneric wisi-prj-identifier-at-point (_project)
+ "Return the identifier at point, move point to start of
+identifier. Signal an error if no identifier is at point."
+ (let ((ident (thing-at-point 'symbol)))
+ (when ident
+ (skip-syntax-backward "w_")
+ ident)))
+
+(defun wisi-check-current-project (file-name &optional default-prj-function)
+ "If FILE-NAME (must be absolute) is found in the current
+project source directories, return the current
+project. Otherwise, if the current project is a wisi project,
+throw an error. If the current project is not a wisi project,
+and DEFAULT-PRJ-FUNCTION is non-nil, use it to return a default
+project. Otherwise throw an error."
+ (let ((visited-file (file-truename file-name)) ;; file-truename handles
symbolic links
+ (project (project-current)))
+ (if (wisi-prj-p project)
+ (let ((found-file (locate-file (file-name-nondirectory visited-file)
+ (wisi-prj-source-path project))))
+ (unless found-file
+ (error "current file not part of current project; wrong project?"))
+
+ (setq found-file (file-truename found-file))
+
+ ;; (nth 10 (file-attributes ...)) is the inode; required when hard
+ ;; links are present.
+ (let* ((visited-file-inode (nth 10 (file-attributes visited-file)))
+ (found-file-inode (nth 10 (file-attributes found-file))))
+ (unless (equal visited-file-inode found-file-inode)
+ (error "%s (opened) and %s (found in project) are two different
files"
+ file-name found-file)))
+ project)
+
+ ;; create a project?
+ (if default-prj-function
+ (funcall default-prj-function nil (file-name-directory file-name))
+ (error "current project is not a wisi project."))
+ )))
+
+(cl-defgeneric wisi-xref-parents (xref project &key identifier filename line
column)
+ "Displays parent type declarations.
+XREF - dispatching object.
+PROJECT - a `wisi-prj' object.
+IDENTIFIER - an identifier or operator_symbol
+FILENAME - absolute filename containing the identifier
+LINE - line number containing the identifier
+COLUMN - Emacs column of the start of the identifier
+
+Displays a buffer in compilation-mode giving locations of the parent type
declarations.")
+
+(defun wisi-show-declaration-parents ()
+ "Display the locations of the parent type declarations of the type
identifier around point."
+ (interactive)
+ (let ((project (wisi-check-current-project (buffer-file-name))))
+ (wisi-xref-parents
+ (wisi-prj-xref project)
+ project
+ :identifier (wisi-prj-identifier-at-point project)
+ :filename (file-name-nondirectory (buffer-file-name))
+ :line (line-number-at-pos)
+ :column (current-column))
+ ))
+
+(cl-defgeneric wisi-xref-all (xref project &key identifier filename line
column local-only append)
+ "Displays cross reference information.
+XREF - dispatching object.
+PROJECT - a `wisi-prj' object.
+IDENTIFIER - an identifier or operator_symbol (a string).
+FILENAME - absolute filename containing the identifier
+LINE - line number containing the identifier
+COLUMN - Emacs column of the start of the identifier
+LOCAL-ONLY - if t, show references in FILE only
+APPEND - if t, keep previous output in result buffer
+Displays a buffer in compilation-mode giving locations where the
+identifier is declared or referenced.")
+
+(defun wisi-show-references (&optional append)
+ "Show all references of identifier at point.
+With prefix, keep previous references in output buffer."
+ (interactive "P")
+ (let ((project (wisi-check-current-project (buffer-file-name))))
+ (wisi-xref-all
+ (wisi-prj-xref project)
+ project
+ :identifier (wisi-prj-identifier-at-point project)
+ :filename (file-name-nondirectory (buffer-file-name))
+ :line (line-number-at-pos)
+ :column (current-column)
+ :local-only nil
+ :append append)
+ ))
+
+(defun wisi-show-local-references (&optional append)
+ "Show all references of identifier at point occuring in current file.
+With prefix, keep previous references in output buffer."
+ (interactive "P")
+ (let ((project (wisi-check-current-project (buffer-file-name))))
+ (wisi-xref-all
+ (wisi-prj-xref project)
+ project
+ :identifier (wisi-prj-identifier-at-point project)
+ :filename (file-name-nondirectory (buffer-file-name))
+ :line (line-number-at-pos)
+ :column (current-column)
+ :local-only t
+ :append append)
+ ))
+
+(cl-defgeneric wisi-xref-overriding (xref project &key identifier filename
line column)
+ "Displays a buffer in compilation-mode giving locations of the overriding
declarations.
+XREF - dispatching object.
+PROJECT - a `wisi-prj' object.
+IDENTIFIER - an identifier or operator_symbol
+FILENAME - filename containing the identifier
+LINE - line number containing the identifier
+COLUMN - Emacs column of the start of the identifier ")
+
+(defun wisi-show-overriding ()
+ "Show all overridings of identifier at point."
+ (interactive)
+ (let ((project (wisi-check-current-project (buffer-file-name))))
+ (wisi-xref-overriding
+ (wisi-prj-xref project)
+ project
+ :identifier (wisi-prj-identifier-at-point project)
+ :filename (file-name-nondirectory (buffer-file-name))
+ :line (line-number-at-pos)
+ :column (current-column))
+ ))
+
+(cl-defgeneric wisi-xref-overridden (xref project &key identifier filename
line column)
+ "Returns a list (FILE LINE COLUMN) giving the location of the overridden
declaration.
+XREF - dispatching object.
+PROJECT - a `wisi-prj' object.
+IDENTIFIER - an identifier or operator_symbol
+FILENAME - absolute filename containing the identifier
+LINE - line number containing the identifier
+COLUMN - Emacs column of the start of the identifier")
+
+(defun wisi-show-overridden ()
+ "Show the overridden declaration of identifier at point."
+ (interactive)
+ (let* ((project (wisi-check-current-project (buffer-file-name)))
+ (target
+ (wisi-xref-overridden
+ (wisi-prj-xref project)
+ project
+ :identifier (wisi-prj-identifier-at-point project)
+ :filename (file-name-nondirectory (buffer-file-name))
+ :line (line-number-at-pos)
+ :column (current-column))))
+
+ (wisi-goto-source (nth 0 target)
+ (nth 1 target)
+ (nth 2 target))
+ ))
+
+;;;; wisi-prj specific methods
+
+(cl-defmethod project-roots ((_project wisi-prj))
+ ;; Not meaningful
+ nil)
+
+(cl-defmethod project-files ((project wisi-prj) &optional dirs)
+ (let (result)
+ (dolist (dir (or dirs
+ (wisi-prj-source-path project)))
+ (mapc
+ (lambda (absfile)
+ (when (and (not (string-equal "." (substring absfile -1)))
+ (not (string-equal ".." (substring absfile -2)))
+ (not (file-directory-p absfile))
+ (or (null (wisi-prj-file-pred project))
+ (funcall (wisi-prj-file-pred project) absfile)))
+ (push absfile result)))
+ (when (file-readable-p dir) ;; GNAT puts non-existing dirs on path.
+ (directory-files dir t))))
+ result))
+
+(defun wisi-refresh-prj-cache (not-full)
+ "Refresh all cached data in the current project, and re-select it.
+With prefix arg, very slow refresh operations may be skipped."
+ (interactive "P")
+ (let ((prj (project-current)))
+ (unless (wisi-prj-p prj)
+ (error "current project is not a wisi project"))
+ (wisi-prj-refresh-cache prj not-full)
+ (wisi-prj-select prj)))
+
+(defvar wisi-prj--current-file nil
+ "Current wisi project file (the most recently selected); an
+absolute file name.")
+
+(defun wisi-prj-clear-current ()
+ "Clear the current project selection; make no project current."
+ (interactive)
+ (setq wisi-prj--current-file nil))
+
+(defun wisi-prj-show ()
+ "Show name of current project."
+ (interactive)
+ (message
+ (cond
+ (wisi-prj--current-file
+ (wisi-prj-name (cdr (assoc wisi-prj--current-file wisi-prj--cache))))
+ (t
+ (let ((prj (project-current)))
+ (if (wisi-prj-p prj)
+ (wisi-prj-name prj)
+ "not a wisi project"))))))
+
+(cl-defmethod wisi-prj-parse-final (project _prj-file)
+ (wisi--case-read-all-exceptions project))
+
+(cl-defmethod wisi-prj-refresh-cache ((project wisi-prj) not-full)
+ (when wisi-prj--cache
+ (wisi-prj-deselect project)
+ (let ((prj-file (car (rassoc project wisi-prj--cache))))
+ (setq wisi-prj--cache (delete (cons prj-file project) wisi-prj--cache))
+ (setq project (wisi-prj-default project))
+ (wisi-prj-parse-file :prj-file prj-file :init-prj project :cache t)
+ (wisi-prj-select project)))
+ (wisi-xref-refresh-cache (wisi-prj-xref project) project not-full))
+
+(cl-defmethod wisi-prj-select ((project wisi-prj))
+ (setq compilation-search-path (wisi-prj-source-path project))
+
+ ;; ‘compilation-environment’ is buffer-local, but the user might
+ ;; delete that buffer. So set both global and local.
+ (let ((comp-env
+ (append
+ (wisi-prj-compile-env project)
+ (wisi-prj-file-env project)
+ (copy-sequence (wisi-prj-file-env project))))
+ (comp-buf (get-buffer "*compilation*")))
+ (when (buffer-live-p comp-buf)
+ (with-current-buffer comp-buf
+ (setq compilation-environment comp-env)))
+ (set-default 'compilation-environment comp-env))
+
+ (wisi-compiler-select-prj (wisi-prj-compiler project) project)
+ (wisi-xref-select-prj (wisi-prj-xref project) project))
+
+(cl-defmethod wisi-prj-deselect ((project wisi-prj))
+ (wisi-xref-deselect-prj (wisi-prj-xref project) project)
+ (wisi-compiler-deselect-prj (wisi-prj-compiler project) project)
+ (setq compilation-environment nil)
+ (setq compilation-search-path nil))
+
+(defvar wisi-prj-parse-hook nil
+ "Hook run at start of `wisi-prj-parse-file'.")
+
+(defvar wisi-prj-parser-alist (list (cons "prj" #'wisi-prj-parse-file-1))
+ "Alist of parsers for project files, indexed by file extension.
+Parser is called with two arguments; the project file name and
+a project. Parser should update the project with values from the file.")
+
+(cl-defmethod wisi-prj-parse-one (project name value)
+ "If NAME is a wisi-prj slot, set it to VALUE, return t.
+Else return nil."
+ (cond
+ ((string= name "casing")
+ (cl-pushnew (expand-file-name
+ (substitute-in-file-name value))
+ (wisi-prj-case-exception-files project)
+ :test #'string-equal)
+ t)
+
+ ((string= name "src_dir")
+ (cl-pushnew (directory-file-name (expand-file-name
(substitute-in-file-name value)))
+ (wisi-prj-source-path project)
+ :test #'string-equal)
+ t)
+
+ ((= ?$ (elt name 0))
+ ;; Process env var.
+ (setf (wisi-prj-file-env project)
+ (cons (concat (substring name 1) "=" (substitute-in-file-name value))
+ (wisi-prj-file-env project)))
+ t)
+
+ ))
+
+(defvar-local wisi-prj-parse-undefined-function nil
+ "Function called if a project file variable name is not recognized.
+Called with three args: PROJECT NAME VALUE.")
+
+(defun wisi-prj-parse-file-1 (prj-file project)
+ "Wisi project file parser."
+ (with-current-buffer (find-file-noselect prj-file)
+ (goto-char (point-min))
+
+ ;; process each line
+ (while (not (eobp))
+
+ ;; ignore lines that don't have the format "name=value", put
+ ;; 'name', 'value' in match-string.
+ (when (looking-at "^\\([^= \n]+\\)=\\(.*\\)")
+ (let ((name (match-string 1))
+ (value (match-string 2))
+ result)
+
+ ;; Both compiler and xref need to see some settings; eg gpr_file, env
vars.
+ (when (wisi-compiler-parse-one (wisi-prj-compiler project) project
name value)
+ (setq result t))
+ (when (wisi-xref-parse-one (wisi-prj-xref project) project name value)
+ (setq result t))
+
+ (unless result
+ (setq result (wisi-prj-parse-one project name value)))
+
+ (when (and (not result)
+ wisi-prj-parse-undefined-function)
+ (funcall wisi-prj-parse-undefined-function project name value))
+
+ ))
+
+ (forward-line 1)
+ )
+ ))
+
+(cl-defun wisi-prj-parse-file (&key prj-file init-prj cache)
+ "Read project file PRJ-FILE with default values from INIT-PRJ.
+PRJ-FILE parser is from `wisi-prj-parser-alist'; if that yields
+no parser, no error occurs; the file is just a placeholder. If
+CACHE is non-nil, add the project to `wisi-prj--cache'. In any
+case, return the project."
+ (setq prj-file (expand-file-name prj-file))
+
+ (run-hooks 'wisi-prj-parse-hook)
+
+ (let* ((default-directory (file-name-directory prj-file))
+ (parser (cdr (assoc (file-name-extension prj-file)
wisi-prj-parser-alist)))
+ (project init-prj)
+ (process-environment (append (wisi-prj-compile-env init-prj)
process-environment)))
+
+ (when parser
+ ;; If no parser, prj-file is just a placeholder; there is no file to
parse.
+ ;; For example, sal-android-prj has no project file.
+ (funcall parser prj-file project)
+ (wisi-prj-parse-final project prj-file)
+ (wisi-compiler-parse-final (wisi-prj-compiler project) project prj-file)
+ (wisi-xref-parse-final (wisi-prj-xref project) project prj-file))
+
+ (when cache
+ ;; Cache the project properties
+ (if (assoc prj-file wisi-prj--cache)
+ (setcdr (assoc prj-file wisi-prj--cache) project)
+ (push (cons prj-file project) wisi-prj--cache)))
+
+ project))
+
+(defun wisi-prj-show-prj-path ()
+ "Show the compiler project file search path."
+ (interactive)
+ (wisi-compiler-show-prj-path (wisi-prj-compiler (wisi-prj-require-prj))))
+
+(defun wisi-prj-show-src-path ()
+ "Show the project source file search path."
+ (interactive)
+ (if compilation-search-path
+ (progn
+ (pop-to-buffer (get-buffer-create "*source file search path*"))
+ (erase-buffer)
+ (dolist (file compilation-search-path)
+ (insert (format "%s\n" file))))
+ (message "no source file search path set")
+ ))
+
+(defun wisi-fix-compiler-error ()
+ "Attempt to fix the current compiler error.
+Point must be at the source location referenced in a compiler error.
+In `compilation-last-buffer', point must be at the compiler error.
+Leave point at fixed code."
+ (interactive)
+ (let ((source-buffer (current-buffer))
+ (line-move-visual nil)); screws up next-line otherwise
+
+ (cond
+ ((equal compilation-last-buffer wisi-error-buffer)
+ (set-buffer source-buffer)
+ (wisi-repair-error))
+
+ (t
+ (with-current-buffer compilation-last-buffer
+ (let ((comp-buf-pt (point))
+ (success
+ (wisi-compiler-fix-error
+ (wisi-prj-compiler (wisi-prj-require-prj))
+ source-buffer)))
+ ;; restore compilation buffer point
+ (set-buffer compilation-last-buffer)
+ (goto-char comp-buf-pt)
+
+ (unless success
+ (error "error not recognized"))
+ )))
+ )))
+
+;;;; auto-casing
+
+(defvar-local wisi-auto-case nil
+ "Buffer-local value indicating whether to change case while typing.
+When non-nil, automatically change case of preceding word while
+typing. Casing of keywords is done according to
+`wisi-case-keyword', identifiers according to
+`wisi-case-identifier'."
+ ;; This is not a defcustom, because it's buffer-local.
+ )
+
+(defvar-local wisi-case-keyword 'lower-case
+ "Indicates how to adjust the case of `wisi-keywords'.
+Value is one of lower-case, upper-case."
+ ;; This is not a defcustom, because it's buffer-local
+ )
+
+(defvar-local wisi-case-identifier 'mixed-case
+ "Buffer-local value indicating how to case language keywords.
+Value is one of:
+
+- mixed-case : Mixed_Case
+- lower-case : lower_case
+- upper-case : UPPER_CASE")
+
+(defvar-local wisi-case-strict t
+ "If nil, preserve uppercase chars in identifiers.")
+
+(defvar-local wisi-language-keywords nil
+ "List of keywords for auto-case.")
+
+(defvar-local wisi-case-adjust-p-function nil
+ "Function taking one argument, the typed char; called from wisi-case-adjust.
+Return non-nil if case of symbol at point should be adjusted.
+Point is on last char of symbol.")
+
+(defun wisi-case-show-files ()
+ "Show casing files list for the current project."
+ (interactive)
+ (let ((project (project-current)))
+
+ (if (and (wisi-prj-p project)
+ (wisi-prj-case-exception-files project))
+ (progn
+ (pop-to-buffer (get-buffer-create "*casing files*"))
+ (erase-buffer)
+ (dolist (file (wisi-prj-case-exception-files project))
+ (insert (format "%s\n" file))))
+ (message "no casing files")
+ )))
+
+(defun wisi--case-save-exceptions (full-exceptions partial-exceptions
file-name)
+ "Save FULL-EXCEPTIONS, PARTIAL-EXCEPTIONS to the file FILE-NAME."
+ ;; If there is a buffer visiting file-name, it may be out of date
+ ;; due to a previous save-exceptions, which will give a user prompt
+ ;; about editing a file that has changed on disk. Update the buffer
+ (let ((buf (get-file-buffer file-name)))
+ (when buf
+ (with-current-buffer buf
+ (revert-buffer nil t t))))
+
+ (with-temp-file (expand-file-name file-name)
+ (mapc (lambda (x) (insert (car x) "\n"))
+ (sort (copy-sequence full-exceptions)
+ (lambda(a b) (string< (car a) (car b)))))
+ (mapc (lambda (x) (insert "*" (car x) "\n"))
+ (sort (copy-sequence partial-exceptions)
+ (lambda(a b) (string< (car a) (car b)))))
+ ))
+
+(defun wisi--case-read-exceptions (file-name)
+ "Read the content of the casing exception file FILE-NAME.
+Return (cons full-exceptions partial-exceptions)."
+ (setq file-name (expand-file-name (substitute-in-file-name file-name)))
+ (if (file-readable-p file-name)
+ (let (full-exceptions partial-exceptions word)
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (while (not (eobp))
+
+ (setq word (buffer-substring-no-properties
+ (point) (save-excursion (skip-syntax-forward "w_")
(point))))
+
+ (if (char-equal (string-to-char word) ?*)
+ ;; partial word exception
+ (progn
+ (setq word (substring word 1))
+ (unless (assoc-string word partial-exceptions t)
+ (push (cons word t) partial-exceptions)))
+
+ ;; full word exception
+ (unless (assoc-string word full-exceptions t)
+ (push (cons word t) full-exceptions)))
+
+ (forward-line 1))
+ )
+ (cons full-exceptions partial-exceptions))
+
+ ;; else file not readable; might be a new project with no
+ ;; exceptions yet, so just return empty pair
+ (message "'%s' is not a readable file." file-name)
+ '(nil . nil)
+ ))
+
+(defun wisi--case-merge-exceptions (result new)
+ "Merge NEW exeptions into RESULT.
+An item in both lists has the RESULT value."
+ (dolist (item new)
+ (unless (assoc-string (car item) result t)
+ (push item result)))
+ result)
+
+(defun wisi--case-merge-all-exceptions (exceptions project)
+ "Merge EXCEPTIONS into PROJECT case-full-exceptions,
case-partial-exceptions."
+ (setf (wisi-prj-case-full-exceptions project)
+ (wisi--case-merge-exceptions (wisi-prj-case-full-exceptions project)
+ (car exceptions)))
+ (setf (wisi-prj-case-partial-exceptions project)
+ (wisi--case-merge-exceptions (wisi-prj-case-partial-exceptions project)
+ (cdr exceptions))))
+
+(defun wisi--case-read-all-exceptions (project)
+ "Read case exceptions from all files in PROJECT casing files."
+ (setf (wisi-prj-case-full-exceptions project) '())
+ (setf (wisi-prj-case-partial-exceptions project) '())
+
+ (dolist (file (wisi-prj-case-exception-files project))
+ (wisi--case-merge-all-exceptions (wisi--case-read-exceptions file)
project)))
+
+(defun wisi--case-add-exception (word exceptions)
+ "Add case exception WORD to EXCEPTIONS, replacing current entry, if any."
+ (if (assoc-string word exceptions t)
+ (setcar (assoc-string word exceptions t) word)
+ (push (cons word t) exceptions))
+ exceptions)
+
+(defun wisi-case-create-exception (&optional partial)
+ "Define a word as an auto-casing exception in the current project.
+The word is the active region, or the symbol at point. If
+PARTIAL is non-nil, create a partial word exception. User is
+prompted to choose a file from the project case-exception-files
+if it is a list."
+ (interactive)
+ (let* ((project (wisi-prj-require-prj))
+ (file-name
+ (cond
+ ((< 1 (length (wisi-prj-case-exception-files project)))
+ (completing-read "case exception file: "
(wisi-prj-case-exception-files project)
+ nil ;; predicate
+ t ;; require-match
+ nil ;; initial-input
+ nil ;; hist
+ (car (wisi-prj-case-exception-files project)) ;;
default
+ ))
+
+ ((= 1 (length (wisi-prj-case-exception-files project)))
+ (car (wisi-prj-case-exception-files project)))
+
+ (t
+ (error "No exception file specified; set `casing' in project
file."))
+ ))
+ word)
+
+ (if (use-region-p)
+ (progn
+ (setq word (buffer-substring-no-properties (region-beginning)
(region-end)))
+ (deactivate-mark))
+ (save-excursion
+ (let ((syntax (if partial "w" "w_")))
+ (skip-syntax-backward syntax)
+ (setq word
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-syntax-forward syntax) (point))
+ )))))
+
+ (let* ((exceptions (wisi--case-read-exceptions file-name))
+ (file-full-exceptions (car exceptions))
+ (file-partial-exceptions (cdr exceptions)))
+
+ (cond
+ ((null partial)
+ (setf (wisi-prj-case-full-exceptions project)
+ (wisi--case-add-exception word (wisi-prj-case-full-exceptions
project)))
+ (setq file-full-exceptions (wisi--case-add-exception word
file-full-exceptions)))
+
+ (t
+ (setf (wisi-prj-case-partial-exceptions project)
+ (wisi--case-add-exception word (wisi-prj-case-partial-exceptions
project)))
+ (setq file-partial-exceptions (wisi--case-add-exception word
file-partial-exceptions)))
+
+ )
+ (wisi--case-save-exceptions file-full-exceptions file-partial-exceptions
file-name)
+ (message "created %s case exception '%s' in file '%s'"
+ (if partial "partial" "full")
+ word
+ file-name)
+ )
+ ))
+
+(defun wisi-case-create-partial-exception ()
+ "Define active region or word at point as a partial word exception.
+User is prompted to choose a file from the project
+case-exception-files if it is a list."
+ (interactive)
+ (wisi-case-create-exception t))
+
+(defun wisi-after-keyword-p ()
+ "Return non-nil if point is after an element of `wisi-language-keywords'."
+ (let ((word (buffer-substring-no-properties
+ (save-excursion (skip-syntax-backward "w_") (point))
+ (point))))
+ (member (downcase word) wisi-language-keywords)))
+
+(defvar-local wisi--ret-binding #'wisi-indent-newline-indent)
+(defvar-local wisi--lfd-binding #'newline-and-indent)
+
+(defun wisi-case-keyword (beg end)
+ (cl-ecase wisi-case-keyword
+ (lower-case (downcase-region beg end))
+ (upper-case (upcase-region beg end))
+ ))
+
+(defun wisi-case-identifier (start end case-strict)
+ (cl-ecase wisi-case-identifier
+ (mixed-case (wisi-mixed-case start end case-strict))
+ (lower-case (downcase-region start end))
+ (upper-case (upcase-region start end))
+ ))
+
+(defun wisi-mixed-case (start end case-strict)
+ "Adjust case of region START END to Mixed_Case."
+ (let ((done nil)
+ next)
+ (if (or case-strict wisi-case-strict)
+ (downcase-region start end))
+ (goto-char start)
+ (while (not done)
+ (setq next
+ (or
+ (save-excursion (when (search-forward "_" end t) (point-marker)))
+ (copy-marker (1+ end))))
+
+ ;; upcase first char
+ (upcase-region (point) (1+ (point)))
+
+ (goto-char next)
+ (if (< (point) end)
+ (setq start (point))
+ (setq done t))
+ )))
+
+(defun wisi-case-adjust-identifier (&optional force-case)
+ "Adjust case of the previous word as an identifier.
+Uses `wisi-case-identifier', with exceptions defined in
+`wisi-case-full-exceptions', `wisi-case-partial-exceptions'. If
+force-case non-nil (default prefix), treat `wisi-strict-case' as
+t."
+ (interactive "P")
+ (save-excursion
+ ;; We don't complain when there is no project; we may be editing a
+ ;; random Ada file.
+ (let ((prj (wisi-prj-current-prj))
+ (end (point-marker))
+ (start (progn (skip-syntax-backward "w_") (point)))
+ match
+ next
+ (done nil))
+
+ (if (setq match
+ (assoc-string (buffer-substring-no-properties start end)
+ (wisi-prj-case-full-exceptions prj)
+ t ;; case-fold
+ ))
+ ;; full word exception
+ (progn
+ ;; 'save-excursion' puts a marker at 'end'; if we do
+ ;; 'delete-region' first, it moves that marker to 'start',
+ ;; then 'insert' inserts replacement text after the
+ ;; marker, defeating 'save-excursion'. So we do 'insert' first.
+ (insert (car match))
+ (delete-region (point) end))
+
+ ;; else apply wisi-case-identifier
+ (wisi-case-identifier start end force-case)
+
+ ;; apply partial-exceptions
+ (goto-char start)
+ (while (not done)
+ (setq next
+ (or
+ (save-excursion (when (search-forward "_" end t)
(point-marker)))
+ (copy-marker (1+ end))))
+
+ (when (setq match (assoc-string (buffer-substring-no-properties start
(1- next))
+ (wisi-prj-case-partial-exceptions prj)
+ t))
+ ;; see comment above at 'full word exception' for why
+ ;; we do insert first.
+ (insert (car match))
+ (delete-region (point) (1- next)))
+
+ (goto-char next)
+ (if (< (point) end)
+ (setq start (point))
+ (setq done t))
+ ))
+ )))
+
+(defun wisi-case-adjust-keyword ()
+ "Adjust the case of the previous symbol as a keyword."
+ (save-excursion
+ (let ((end (point-marker))
+ (start (progn (skip-syntax-backward "w_") (point))))
+ (wisi-case-keyword start end)
+ )))
+
+(defun wisi-case-adjust (&optional typed-char in-comment)
+ "Adjust the case of the symbol before point.
+When invoked interactively, TYPED-CHAR must be
+`last-command-event', and it must not have been inserted yet. If
+IN-COMMENT is non-nil, adjust case of words in comments and
+strings as code, and treat `wisi-case-strict' as t in code."
+ (when (not (bobp))
+ (when (save-excursion
+ (forward-char -1); back to last character in symbol
+ (and (not (bobp))
+ (eq (char-syntax (char-after)) ?w); it can be capitalized
+
+ (or in-comment
+ (not (wisi-in-string-or-comment-p)))
+
+ (or (null wisi-case-adjust-p-function)
+ (funcall wisi-case-adjust-p-function typed-char))
+ ))
+
+ ;; The indentation engine may trigger a reparse on
+ ;; non-whitespace changes, but we know we don't need to reparse
+ ;; for this change (assuming the user has not abused case
+ ;; exceptions!).
+ (let ((inhibit-modification-hooks t))
+ (cond
+ ;; Some attributes are also keywords, but captialized as
+ ;; attributes. So check for attribute first.
+ ((and
+ (not in-comment)
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (eq (char-before) ?')))
+ (wisi-case-adjust-identifier in-comment))
+
+ ((and
+ (not in-comment)
+ (not (eq typed-char ?_))
+ (wisi-after-keyword-p))
+ (wisi-case-adjust-keyword))
+
+ (t (wisi-case-adjust-identifier in-comment))
+ ))
+ )))
+
+(defun wisi-case-adjust-at-point (&optional in-comment)
+ "If ’wisi-auto-case’ is non-nil, adjust case of symbol at point.
+Also move to end of symbol. With prefix arg, adjust case as code
+even if in comment or string; otherwise, capitalize words in
+comments and strings. If ’wisi-auto-case’ is nil, capitalize
+current word."
+ (interactive "P")
+ (cond
+ ((or (null wisi-auto-case)
+ (and (not in-comment)
+ (wisi-in-string-or-comment-p)))
+ (skip-syntax-backward "w_")
+ (capitalize-word 1))
+
+ (t
+ (when
+ (and (not (eobp))
+ ;; We use '(syntax-after (point))' here, not '(char-syntax
+ ;; (char-after))', because the latter does not respect
+ ;; syntax-propertize functions
+ (memq (syntax-class (syntax-after (point))) '(2 3)))
+ (skip-syntax-forward "w_"))
+ (wisi-case-adjust nil in-comment))
+ ))
+
+(defun wisi-case-adjust-region (begin end)
+ "Adjust case of all words in region BEGIN END."
+ (interactive "r")
+ (narrow-to-region begin end)
+ (save-excursion
+ (goto-char begin)
+ (while (not (eobp))
+ (forward-comment (point-max))
+ (skip-syntax-forward "^w_")
+ (skip-syntax-forward "w_")
+ (wisi-case-adjust)))
+ (widen))
+
+(defun wisi-case-adjust-buffer ()
+ "Adjust case of current buffer."
+ (interactive)
+ (wisi-case-adjust-region (point-min) (point-max)))
+
+(defun wisi-case-adjust-interactive (arg)
+ "If `wisi-auto-case' is non-nil, adjust the case of the previous symbol,
+and process the character just typed. To be bound to keys that
+should cause auto-casing. ARG is the prefix the user entered
+with \\[universal-argument]."
+ (interactive "P")
+
+ ;; Character typed has not been inserted yet.
+ (let ((lastk last-command-event)
+ (do-adjust nil))
+ (cond
+ ((null wisi-auto-case))
+ (t
+ (setq do-adjust t)))
+
+ (cond
+ ((eq lastk ?\n)
+ (when do-adjust
+ (wisi-case-adjust lastk))
+ (funcall wisi--lfd-binding))
+
+ ((memq lastk '(?\r return))
+ (when do-adjust
+ (wisi-case-adjust lastk))
+ (funcall wisi--ret-binding))
+
+ (t
+ (when do-adjust
+ (wisi-case-adjust lastk))
+ (self-insert-command (prefix-numeric-value arg)))
+ )))
+
+(defun wisi-case-activate-keys (map)
+ "Modify the key bindings for all the keys that should adjust casing."
+ (mapc (function
+ (lambda(key)
+ (define-key
+ map
+ (char-to-string key)
+ 'wisi-case-adjust-interactive)))
+ '( ?_ ?% ?& ?* ?\( ?\) ?- ?= ?+
+ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))
+ )
+
+;;;; xref backend
+
+(cl-defmethod xref-backend-definitions ((prj wisi-prj) identifier)
+ (wisi-xref-definitions (wisi-prj-xref prj) prj (wisi-xref-item identifier)))
+
+(cl-defmethod xref-backend-identifier-at-point ((prj wisi-prj))
+ (save-excursion
+ (condition-case nil
+ (let ((ident (wisi-prj-identifier-at-point prj))) ;; moves point to
start of ident
+ (put-text-property
+ 0 1
+ 'xref-identifier
+ (list ':file (buffer-file-name)
+ ':line (line-number-at-pos)
+ ':column (current-column))
+ ident)
+ ident)
+ (error
+ ;; from wisi-prj-identifier-at-point; no identifier
+ nil))))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_prj wisi-prj))
+ ;; Current buffer only.
+ (wisi-names nil))
+
+(cl-defmethod xref-backend-references ((prj wisi-prj) identifier)
+ (wisi-xref-references (wisi-prj-xref prj) prj (wisi-xref-item identifier)))
+
+;;;###autoload
+(defun wisi-prj-xref-backend ()
+ "For `xref-backend-functions'; return the current wisi project."
+ ;; We return the project, not the xref object, because the
+ ;; wisi-xref-* functions need the project.
+ (let ((prj (project-current)))
+ (when (wisi-prj-p prj)
+ prj)))
+
+;;;; project-find-functions alternatives
+
+(defvar wisi-prj--dominating-alist nil
+"Alist of (DOMINATING-FILE . PRJ-FILE-NAME): DOMINATING-FILE is
+an absolute filename that can be found by
+`wisi-prj-find-dominating-cached' or
+`wisi-prj-find-dominating-cached'. PRJ-FILE-NAME is the wisi
+project file for the project for that file.")
+
+;;;###autoload
+(defun wisi-prj-select-cache (prj-file init-prj &optional dominating-file)
+ "Select project matching PRJ-FILE in `wisi-prj--cache' as current project,
+parsing and caching if needed. Also add DOMINATING-FILE (default
+current buffer file name) to `wisi-prj--dominating-alist' (for
+`wisi-prj-select-dominating'.)"
+ (let ((old-prj (project-current)))
+ ;; If old-prj is not a wisi-prj, we don't know how to deselect it;
+ ;; just ignore that. If prj-file is the current file, user is
+ ;; re-selecting it.
+ (when (wisi-prj-p old-prj)
+ (wisi-prj-deselect old-prj)))
+
+ (unless (or (memq #'wisi-prj-current-cached project-find-functions)
+ (memq #'wisi-prj-current-cached (default-value
'project-find-functions)))
+ (message "wisi-prj-select-cache used without wisi-prj-current-cached in
project-find-functions"))
+
+ (setq dominating-file (if dominating-file (expand-file-name dominating-file)
(buffer-file-name)))
+ (setq prj-file (expand-file-name prj-file))
+ (add-to-list 'wisi-prj--dominating-alist (cons dominating-file prj-file))
+
+ (let ((new-prj (cdr (assoc prj-file wisi-prj--cache))))
+ (unless new-prj
+ (setq new-prj (wisi-prj-parse-file :prj-file prj-file :init-prj init-prj
:cache t))
+ (unless new-prj
+ (error "parsing project file '%s' failed" prj-file)))
+
+ (setq wisi-prj--current-file prj-file)
+ (wisi-prj-select new-prj)))
+
+;;;###autoload
+(defun wisi-prj-select-dominating (&optional dominating-file)
+ "Unless it is already current, select a wisi-prj matching DOMINATING-FILE.
+DOMINATING-FILE defaults to the current buffer file name.
+Useful before running `compilation-start', to ensure the correct
+project is current."
+ (when (or dominating-file (buffer-file-name))
+ ;; buffer-file-name is nil in *compilation* buffer
+ (let ((prj-file (cdr (assoc (or dominating-file (buffer-file-name))
wisi-prj--dominating-alist))))
+ (unless (string-equal prj-file wisi-prj--current-file)
+ (message "Switching to project file '%s'" prj-file)
+ (let ((old-prj (cdr (assoc wisi-prj--current-file wisi-prj--cache)))
+ (new-prj (cdr (assoc prj-file wisi-prj--cache))))
+ (when (wisi-prj-p old-prj)
+ (wisi-prj-deselect old-prj))
+ (when (wisi-prj-p new-prj)
+ (wisi-prj-select new-prj))
+ (setq wisi-prj--current-file prj-file))))))
+
+;;;###autoload
+(defun wisi-prj-current-cached (_dir)
+ "For `project-find-functions'; return the current project from
`wisi-prj--cache'."
+ (cdr (assoc wisi-prj--current-file wisi-prj--cache)))
+
+(defvar wisi-prj--default nil
+ "Alist of (PRJ-FILE . INIT-PRJ), for `wisi-prj-parse-current'.
+PRJ-FILE is an absolute project file name; INIT-PRJ is the
+initial `wisi-prj' object for that project file.")
+
+;;;###autoload
+(defun wisi-prj-select-file (prj-file default-prj &optional dominating-file)
+ "Set PRJ-FILE as current project, add DEFAULT-PRJ to `wisi-prj--default'.
+Also add DOMINATING-FILE (default current buffer file name) to
+`wisi-prj--dominating-alist' (for `wisi-prj-select-dominating'.)"
+ (unless (or (memq #'wisi-prj-current-parse project-find-functions)
+ (memq #'wisi-prj-current-parse (default-value
'project-find-functions)))
+ (message "wisi-prj-select-file used without wisi-prj-current-parse in
project-find-functions"))
+
+ (setq dominating-file (if dominating-file (expand-file-name dominating-file)
(buffer-file-name)))
+ (setq prj-file (expand-file-name prj-file))
+ (add-to-list 'wisi-prj--dominating-alist (cons dominating-file prj-file))
+ (setq wisi-prj--current-file prj-file)
+ (add-to-list 'wisi-prj--default (cons prj-file default-prj)))
+
+;;;###autoload
+(defun wisi-prj-current-parse (_dir)
+ "For `project-find-functions'; parse the current project file, select and
return the project"
+ (let ((prj (wisi-prj-parse-file
+ :prj-file wisi-prj--current-file
+ :init-prj (cdr (assoc-string wisi-prj--current-file
wisi-prj--default))
+ :cache nil)))
+ (wisi-prj-select prj)
+ prj))
+
+(defvar wisi-prj--dominating nil
+ "List of relative filenames for `wisi-prj-find-dominating-cached'
+and `wisi-prj-find-dominating-parse'. Set by `wisi-prj-set-dominating'.")
+
+(defun wisi-prj-reset-cache ()
+ "Delete all wisi project cached info."
+ (interactive)
+ (setq wisi-prj--cache nil)
+ (setq wisi-prj--current-file nil)
+ (setq wisi-prj--default nil)
+ (setq wisi-prj--dominating nil)
+ (setq wisi-prj--dominating-alist nil))
+
+;;;###autoload
+(defun wisi-prj-cache-dominating (prj-file default-prj &optional
dominating-file)
+ "Parse prj-file, add to `wisi-prj--cache'.
+Also add (DOMINATING-FILE . PRJ-FILE) to `wisi-prj--dominating-alist'.
+DOMINATING-FILE defaults to (buffer-file-name). "
+ (unless (or (memq #'wisi-prj-find-dominating-cached project-find-functions)
+ (memq #'wisi-prj-find-dominating-cached (default-value
'project-find-functions)))
+ (message "wisi-prj-cache-dominating used without
wisi-prj-find-dominating-cached in project-find-functions"))
+
+ (setq dominating-file (if dominating-file (expand-file-name dominating-file)
(buffer-file-name)))
+ (setq prj-file (expand-file-name prj-file))
+ (add-to-list 'wisi-prj--dominating (file-name-nondirectory dominating-file))
+ (add-to-list 'wisi-prj--dominating-alist (cons dominating-file prj-file))
+ (wisi-prj-parse-file :prj-file prj-file :init-prj default-prj :cache t)
+ nil)
+
+(defun wisi-prj--find-dominating-file (start-dir)
+ "Return the project file matching `wisi-prj--dominating'."
+ (let* (dom-file
+ (_dom-dir
+ (locate-dominating-file
+ start-dir
+ (lambda (dir)
+ (let ((names wisi-prj--dominating))
+ (while names
+ (let ((filename (expand-file-name (pop names) dir)))
+ (when (file-exists-p filename)
+ (setq dom-file filename)
+ (setq names nil)))))
+ dom-file))))
+ (cdr (assoc-string dom-file wisi-prj--dominating-alist))))
+
+;;;###autoload
+(defun wisi-prj-find-dominating-cached (dir)
+ "For `project-find-functions'; return the cached project
+matching `wisi-prj--dominating' (nil if none). Select it if it is
+not the current project."
+ (let* ((prj-file (wisi-prj--find-dominating-file dir))
+ (new-prj (cdr (assoc-string prj-file wisi-prj--cache))))
+ (when prj-file
+ (unless (string= prj-file wisi-prj--current-file)
+ (let ((old-prj (cdr (assoc-string wisi-prj--current-file
wisi-prj--cache))))
+ (when old-prj (wisi-prj-deselect old-prj))
+ (unless new-prj
+ ;; User may have used `wisi-prj-set-dominating' instead of
+ ;; `wisi-prj-cache-dominating'; parse the project file now.
+ (wisi-prj-parse-file
+ :prj-file prj-file
+ :init-prj (cdr (assoc-string prj-file wisi-prj--default))
+ :cache t))
+ (when new-prj (wisi-prj-select new-prj))))
+ new-prj)))
+
+;;;###autoload
+(defun wisi-prj-set-dominating (prj-file default-prj &optional dom-file)
+ "Add (DOM-FILE . PRJ-FILE) to `wisi-prj--dominating-alist',
+and (PRJ-FILE . DEFAULT-PRJ) to `wisi-prj--default'.
+DOM-FILE defaults to (buffer-file-name).
+For example, call this in the Local Vars of a Makefile to
+associate a project with that Makefile."
+ (unless (or (memq #'wisi-prj-find-dominating-parse project-find-functions)
+ (memq #'wisi-prj-find-dominating-parse (default-value
'project-find-functions)))
+ (message "wisi-prj-cache-dominating used without
wisi-prj-find-dominating-parse in project-find-functions"))
+
+ (setq dom-file (if dom-file (expand-file-name dom-file) (buffer-file-name)))
+ (setq prj-file (expand-file-name prj-file))
+ (add-to-list 'wisi-prj--dominating (file-name-nondirectory dom-file))
+ (add-to-list 'wisi-prj--dominating-alist (cons dom-file prj-file))
+ (add-to-list 'wisi-prj--default (cons prj-file default-prj))
+ nil)
+
+;;;###autoload
+(defun wisi-prj-find-dominating-parse (dir)
+ "For `project-find-functions'; parse, select, and return the project
+file matching `wisi-prj--dominating'."
+ (let ((prj-file (wisi-prj--find-dominating-file dir)))
+ (when prj-file
+ (let ((prj (wisi-prj-parse-file
+ :prj-file prj-file
+ :init-prj (cdr (assoc-string prj-file wisi-prj--default))
+ :cache nil)))
+ (wisi-prj-select prj)
+ prj))))
+
+;;;###autoload
+(defun wisi-prj-dtrt-parse-file (prj-file default-prj dominating-file
&optional dir)
+ "Depending on wisi-prj function in `project-find-functions',
+Do The Right Thing to make PRJ-FILE active and selected; return the project."
+ (cond
+ ((memq #'wisi-prj-find-dominating-parse project-find-functions)
+ (wisi-prj-set-dominating prj-file default-prj dominating-file))
+
+ ((memq #'wisi-prj-find-dominating-cached project-find-functions)
+ (wisi-prj-cache-dominating prj-file default-prj dominating-file))
+
+ ((memq #'wisi-prj-current-cached project-find-functions)
+ (wisi-prj-select-cache prj-file default-prj dominating-file))
+
+ ((memq #'wisi-prj-current-parse project-find-functions)
+ (wisi-prj-select-file prj-file default-prj dominating-file))
+
+ (t
+ (user-error "No wisi-prj function in project-find-functions"))
+ )
+ (project-current nil (or dir default-directory)))
+
+;;;###autoload
+(defun wisi-prj-find-function-set-p ()
+ "Return non-nil if a wisi-prj function is present in
`project-find-functions'."
+ (or (memq #'wisi-prj-find-dominating-parse project-find-functions)
+ (memq #'wisi-prj-find-dominating-cached project-find-functions)
+ (memq #'wisi-prj-current-cached project-find-functions)
+ (memq #'wisi-prj-current-parse project-find-functions)))
+
+;;;; project menu
+
+(defun wisi-prj--menu-compute ()
+ "Return an easy-menu menu for `wisi-prj-menu--install'.
+Menu displays cached wisi projects."
+ (let (menu)
+ (dolist (item wisi-prj--cache)
+ (push
+ (vector
+ (concat (wisi-prj-name (cdr item))
+ (when (equal (car item) wisi-prj--current-file) " *")) ;;
current project
+ `(lambda () (interactive)
+ (when wisi-prj--current-file
+ (wisi-prj-deselect (cdr (assoc wisi-prj--current-file
wisi-prj--cache))))
+ (setq wisi-prj--current-file ,(car item))
+ (wisi-prj-select ,(cdr item)))
+ t)
+ menu)
+ )
+ (nreverse menu)))
+
+(defun wisi-prj-menu-install ()
+ "Install the project menu if appropriate, to display cached wisi projects."
+ (when
+ (or (memq #'wisi-prj-find-dominating-cached project-find-functions)
+ (memq #'wisi-prj-current-cached project-find-functions))
+
+ (let ((menu (wisi-prj--menu-compute)))
+ (if menu
+ (define-key-after
+ global-map
+ [menu-bar wisi-prj-select]
+ (easy-menu-binding
+ (easy-menu-create-menu
+ "Wisi Prj Select";; EDE uses "Project" menu
+ menu))
+ (lookup-key global-map [menu-bar tools]))
+ ;; delete empty menu
+ (define-key-after
+ global-map
+ [menu-bar wisi-prj-select]
+ nil
+ (lookup-key global-map [menu-bar tools]))
+ ))
+ ))
+
+(add-hook 'menu-bar-update-hook 'wisi-prj-menu-install)
+
+(defun wisi-prj-completion-table ()
+ "Return list of names of cached projects."
+ (mapcar (lambda (item) (wisi-prj-name (cdr item))) wisi-prj--cache))
+
+(defun wisi-prj-delete (name)
+ "Delete project NAME (default prompt) from the cached projects."
+ (interactive (list (completing-read "project name: "
(wisi-prj-completion-table))))
+ (let (pair)
+ (dolist (item wisi-prj--cache)
+ (if (string= name (wisi-prj-name (cdr item)))
+ (setq pair item)))
+
+ (setq wisi-prj--cache (delete pair wisi-prj--cache))
+
+ (setq wisi-prj--dominating-alist
+ (cl-delete-if (lambda (item)
+ (string= (car pair) (cdr item)))
+ wisi-prj--dominating-alist))
+ ))
+
+(provide 'wisi-prj)
+;; end wisi-prj.el
diff --git a/wisi-process-parse.el b/wisi-process-parse.el
index 5fb025d..46abc92 100644
--- a/wisi-process-parse.el
+++ b/wisi-process-parse.el
@@ -1,6 +1,6 @@
;;; wisi-process-parse.el --- interface to external parse program
;;
-;; Copyright (C) 2014, 2017 - 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2017 - 2020 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;;
@@ -31,10 +31,10 @@
is no response from the parser after waiting this amount (in
seconds)."
:type 'float
- :safe 'floatp)
+ :safe 'numberp)
(make-variable-buffer-local 'wisi-process-time-out)
-(defconst wisi-process-parse-protocol-version "4"
+(defconst wisi-process-parse-protocol-version "5"
"Defines data exchanged between this package and the background process.
Must match emacs_wisi_common_parse.ads Protocol_Version.")
@@ -83,7 +83,8 @@ Otherwise add PARSER to ‘wisi-process--alist’, return it."
(let ((exec-file (locate-file (wisi-process--parser-exec-file parser)
exec-path '("" ".exe"))))
(unless exec-file
- (error "%s not found on `exec-path'" (wisi-process--parser-exec-file
parser)))
+ (error "%s not found on `exec-path'; run 'build.sh' in the ELPA
package."
+ (wisi-process--parser-exec-file parser)))
(push (cons (wisi-process--parser-label parser) parser)
wisi-process--alist)
@@ -225,7 +226,7 @@ PARSE-END, wait for command to complete. PARSER will
respond with
one or more Edit messages."
;; Must match "refactor" command arguments read by
;; emacs_wisi_common_parse.adb Get_Refactor_Params.
- (let* ((cmd (format "refactor %d \"%s\" %d %d %d %d %d %d %d %d %d %d %d"
+ (let* ((cmd (format "refactor %d \"%s\" %d %d %d %d %d %d %d %d %d %d %d %d"
refactor-action
(if (buffer-file-name) (file-name-nondirectory
(buffer-file-name)) "")
(position-bytes parse-begin)
@@ -234,6 +235,7 @@ one or more Edit messages."
parse-begin ;; char_pos
(line-number-at-pos parse-begin)
(line-number-at-pos parse-end)
+ (save-excursion (goto-char parse-begin)
(back-to-indentation) (current-column));; indent-begin
(if (> wisi-debug 0) 1 0) ;; debug-mode
(1- wisi-debug) ;; trace_parse
wisi-trace-action
@@ -396,7 +398,7 @@ complete."
(cl-do ((i 1 (1+ i))) ((= i (length sexp)))
(push
(make-wisi--parse-error-repair
- :pos (aref (aref sexp i) 0)
+ :pos (copy-marker (aref (aref sexp i) 0))
:inserted (mapcar (lambda (id) (aref token-table id)) (aref (aref
sexp i) 1))
:deleted (mapcar (lambda (id) (aref token-table id)) (aref (aref
sexp i) 2))
:deleted-region (aref (aref sexp i) 3))
@@ -406,7 +408,7 @@ complete."
(defun wisi-process-parse--End (parser sexp)
;; sexp is [End pos]
;; see ‘wisi-process-parse--execute’
- (setf (wisi-process--parser-end-pos parser) (aref sexp 1)))
+ (setf (wisi-process--parser-end-pos parser) (1+ (aref sexp 1))))
(defun wisi-process-parse--Edit (parser sexp)
;; sexp is [Edit begin end text]
@@ -703,7 +705,7 @@ complete."
(when (and (= (point-max) need-more)
(> (wisi-process--parser-total-wait-time parser)
wisi-process-time-out))
- (error "wisi-process-parse not getting more text (or bad syntax
in process output)"))
+ (error "wisi-process-parse timing out; increase
`wisi-process-time-out'? (or bad syntax in process output)"))
(setq need-more nil))
);; while not done
diff --git a/wisi-run-indent-test.el b/wisi-run-indent-test.el
index fcf0b33..269b3d9 100644
--- a/wisi-run-indent-test.el
+++ b/wisi-run-indent-test.el
@@ -1,6 +1,6 @@
;;; wisi-run-indent-test.el --- utils for automating indentation and casing
tests
;;
-;; Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
;;
;; This file is part of GNU Emacs.
;;
@@ -18,6 +18,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
(require 'wisi-tests)
+(require 'wisi-prj)
;; user can set these to t in an EMACSCMD
(defvar skip-cmds nil)
@@ -170,6 +171,11 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(setq indent-tabs-mode nil)
(setq jit-lock-context-time 0.0);; for test-face
+ ;; Test files use wisi-prj-select-cached to parse and select a project file.
+ (setq project-find-functions (list #'wisi-prj-current-cached))
+ (setq xref-backend-functions (list #'wisi-prj-xref-backend))
+
+
(let ((error-count 0)
(test-buffer (current-buffer))
cmd-line
@@ -185,6 +191,11 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
;; of the previous EMACSCMD, and the test fails if they don't
;; match.
;;
+ ;; EMACSRESULT_START:<first list element>
+ ;; EMACSRESULT_ADD: <list element>
+ ;; EMACSRESULT_FINISH:
+ ;; build a list, compare it to the result of the previous EMACSCMD.
+ ;;
;; EMACS_SKIP_UNLESS: <form>
;; skip entire test if form evals nil
;;
@@ -223,7 +234,6 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(looking-at ".*$")
(setq expected-result (save-excursion (end-of-line 1) (eval (car
(read-from-string (match-string 0))))))
(unless (equal expected-result last-result)
- (when debug-on-error (debug))
(setq error-count (1+ error-count))
(message
(concat
@@ -234,6 +244,43 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
expected-result)
))))
+ ((string= (match-string 1) "RESULT_START")
+ (looking-at ".*$")
+ (setq expected-result (list (save-excursion (end-of-line 1) (eval (car
(read-from-string (match-string 0))))))))
+
+ ((string= (match-string 1) "RESULT_ADD")
+ (looking-at ".*$")
+ (let ((val (save-excursion (end-of-line 1)
+ (eval (car (read-from-string (match-string
0)))))))
+ (when val
+ (setq expected-result (append expected-result (list val))))))
+
+ ((string= (match-string 1) "RESULT_FINISH")
+ (unless (equal (length expected-result) (length last-result))
+ (setq error-count (1+ error-count))
+ (message
+ (concat
+ (format "error: %s:%d:\n" (buffer-file-name) (line-number-at-pos))
+ (format "Length of result of '%s' does not match.\nGot
'%s',\nexpect '%s'"
+ last-cmd
+ (length last-result)
+ (length expected-result)))))
+
+ (let ((i 0))
+ (while (< i (length expected-result))
+ (unless (equal (nth i expected-result) (nth i last-result))
+ (setq error-count (1+ error-count))
+ (message
+ (concat
+ (format "error: %s:%d:\n" (buffer-file-name)
(line-number-at-pos))
+ (format "Nth (%d) result of '%s' does not match.\nGot
'%s',\nexpect '%s'"
+ i
+ last-cmd
+ (nth i last-result)
+ (nth i expected-result))
+ )))
+ (setq i (1+ i)))))
+
((string= (match-string 1) "_SKIP_UNLESS")
(looking-at ".*$")
(unless (eval (car (read-from-string (match-string 0))))
@@ -261,7 +308,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(buffer-file-name) (line-number-at-pos (point)) error-count))
)
- (when (not skip-reindent-test)
+ (unless skip-reindent-test
;; Reindent the buffer
(message "indenting")
@@ -278,11 +325,18 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
;; files must be saved without any.
(delete-trailing-whitespace)
)
+
+ (when (and wisi-auto-case (not skip-recase-test))
+ (message "casing")
+ (wisi-case-adjust-buffer))
)
(defun run-test (file-name)
"Run an indentation and casing test on FILE-NAME."
(interactive "f")
+
+ (package-initialize) ;; for uniquify-files
+
;; we'd like to run emacs from a makefile as:
;;
;; emacs -Q --batch -l runtest.el -f run-test-here <filename>
@@ -304,14 +358,11 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
;; that rely on font-lock do explicitly.
(setq font-lock-support-mode nil)
+ (setq xref-prompt-for-identifier nil)
+
(let ((dir default-directory))
(find-file file-name) ;; sets default-directory
- (when (eq major-mode 'fundamental-mode)
- ;; Running a grammar in test/wisi
- (add-to-list 'load-path (expand-file-name "."))
- (wisi-tests-setup (file-name-sans-extension (file-name-nondirectory
file-name))))
-
(run-test-here)
(unless skip-write
diff --git a/wisi-skel.el b/wisi-skel.el
new file mode 100644
index 0000000..96693fd
--- /dev/null
+++ b/wisi-skel.el
@@ -0,0 +1,154 @@
+;;; wisi-skel.el --- Extensions skeleton -*- lexical-binding:t -*-
+
+;; Copyright (C) 1987, 1993, 1994, 1996-2019 Free Software Foundation, Inc.
+
+;; Authors: Stephen Leake <stephen_leake@stephe-leake.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/>.
+
+;;; Design:
+;;
+;; The primary user command is `wisi-skel-expand', which inserts the
+;; skeleton associated with the previous word (possibly skipping a
+;; name).
+;;
+
+(defvar-local wisi-skel-token-alist nil
+ "Alist of (STRING . ELEMENT), used by `wisi-skel-expand'.
+STRING must be a symbol in the current syntax, and is normally
+the first language keyword in the skeleton.
+
+ELEMENT may be:
+- a skeleton, which is inserted
+- an alist of (STRING . SKELETON). User is prompted with `completing-read',
+ selected skeleton is inserted.")
+
+(defun wisi-skel-build-prompt (alist count)
+ "Build a prompt from the keys of the ALIST.
+The prompt consists of the first COUNT keys from the alist, separated by `|',
with
+trailing `...' if there are more keys."
+ (if (>= count (length alist))
+ (concat (mapconcat 'car alist " | ") " : ")
+ (let ((alist-1 (butlast alist (- (length alist) count))))
+ (concat (mapconcat 'car alist-1 " | ") " | ... : "))
+ ))
+
+(defvar wisi-skel-test-input nil
+ "Override prompt for input from wisi-skel-token-alist, for unit testing."
+ ;; see test/ada_skel.adb
+ )
+
+(defun wisi-skel-expand (&optional name)
+ "Expand the token or placeholder before point to a skeleton.
+Tokens are defined by `wisi-skel-token-alist'; they must have
+symbol syntax. A placeholder is a token enclosed in generic
+comment delimiters. If the symbol before point is not in
+`wisi-skel-token-alist', assume it is a name, and use the symbol
+before that as the token."
+ (interactive "*")
+
+ ;; Skip trailing space, newline, and placeholder delimiter.
+ ;; Standard comment end included for languages where that is newline.
+ (skip-syntax-backward " !>")
+
+ (let* ((wisi-inhibit-parse t) ;; don't parse until skeleton is fully inserted
+ (end (point))
+ ;; Include punctuation here, to handle a dotted name (ie Ada.Text_IO)
+ (token (progn (skip-syntax-backward "w_.")
+ (downcase (buffer-substring-no-properties (point) end))))
+ (skel (assoc-string token wisi-skel-token-alist))
+ (handled nil))
+
+ (if skel
+ (progn
+ (when (listp (cdr skel))
+ (let* ((alist (cdr skel))
+ (prompt (wisi-skel-build-prompt alist 4)))
+ (setq skel (assoc-string
+ (or wisi-skel-test-input (completing-read prompt
alist))
+ alist))
+ ))
+
+ ;; delete placeholder delimiters around token, token, and
+ ;; name. point is currently before token.
+ (skip-syntax-backward "!")
+ (delete-region
+ (point)
+ (progn
+ (skip-syntax-forward "!w_")
+ (when name
+ (skip-syntax-forward " ")
+ (skip-syntax-forward "w_."))
+ (point)))
+ (funcall (cdr skel) name)
+ (setq handled t))
+
+ ;; word in point .. end is not a token; assume it is a name
+ (when (not name)
+ ;; avoid infinite recursion
+
+ (when wisi-auto-case
+ ;; Adjust case now, because skeleton insert won't.
+ ;;
+ ;; We didn't do it above, because we don't want to adjust case
+ ;; on tokens and placeholders.
+ (save-excursion (wisi-case-adjust-region (point) end)))
+
+ (wisi-skel-expand (buffer-substring-no-properties (point) end))
+ (setq handled t)))
+
+ (when (not handled)
+ (user-error "'%s' is not a skeleton token" name))
+ ))
+
+;;;###autoload
+(defun wisi-skel-hippie-try (old)
+ "For `hippie-expand-try-functions-list'."
+ (if old
+ ;; hippie is asking us to try the "next" completion; we don't have one
+ nil
+ (let ((pos (point))
+ (undo-len (if (eq 't pending-undo-list)
+ 0
+ (length pending-undo-list))))
+ (undo-boundary)
+ (condition-case nil
+ (progn
+ (wisi-skel-expand)
+ t)
+ (error
+ ;; undo hook action if any
+ (unless (or (eq 't pending-undo-list)
+ (= undo-len (length pending-undo-list)))
+ (undo))
+
+ ;; undo motion
+ (goto-char pos)
+ nil)))))
+
+(defun wisi-skel-next-placeholder ()
+ "Move point to after next placeholder."
+ (interactive)
+ (skip-syntax-forward "^!")
+ (skip-syntax-forward "w_!"))
+
+(defun wisi-skel-prev-placeholder ()
+ "Move point to after previous placeholder."
+ (interactive)
+ (skip-syntax-backward "^!"))
+
+(provide 'wisi-skel)
+;;; wisi-skel.el ends here
diff --git a/wisi.adb b/wisi.adb
index 1ba7a4f..227c45c 100644
--- a/wisi.adb
+++ b/wisi.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -95,7 +95,7 @@ package body Wisi is
Indent : in out Indent_Type)
with Pre => Delta_Indent.Label = Anchored
is begin
- -- [2] wisi-elisp-parse--apply-anchored; add Delta_Indent to Indent
+ -- Add Delta_Indent to Indent
case Indent.Label is
when Not_Set =>
@@ -130,7 +130,7 @@ package body Wisi is
procedure Indent_Apply_Int (Indent : in out Indent_Type; Offset : in
Integer)
is begin
- -- [2] wisi-elisp-parse--apply-int; add an Int indent to Indent
+ -- Add an Int indent to Indent
case Indent.Label is
when Not_Set =>
Indent := (Int, Offset);
@@ -255,8 +255,6 @@ package body Wisi is
Paren_Char_Pos : Buffer_Pos := Invalid_Buffer_Pos;
Text_Begin_Pos : Buffer_Pos := Invalid_Buffer_Pos;
begin
- -- [1] wisi-elisp-parse--paren-in-anchor-line. That uses elisp
syntax-ppss; here
- -- we search Terminals.
loop
declare
Tok : Augmented_Token renames Data.Terminals (I);
@@ -332,8 +330,8 @@ package body Wisi is
begin
if Cache.Face.Set then
Append (Line, Face_Property_Code);
- Append (Line, Buffer_Pos'Image (Cache.Region.First));
- Append (Line, Buffer_Pos'Image (Cache.Region.Last));
+ Append (Line, Buffer_Pos'Image (Cache.Char_Region.First));
+ Append (Line, Buffer_Pos'Image (Cache.Char_Region.Last));
Append (Line, Integer'Image (Cache.Face.Item));
Append (Line, ']');
Ada.Text_IO.Put_Line (To_String (Line));
@@ -644,7 +642,7 @@ package body Wisi is
Data.Terminals.Clear;
Data.Leading_Non_Grammar.Clear;
-- Data.Line_Begin_Pos set in Initialize, overwritten in
Lexer_To_Augmented
- -- Data.Line_Begin_Token ""
+ -- Data.Line_Begin_Token set in WisiToken.Parse.Next_Grammar_Token.
for S of Data.Line_Paren_State loop
S := 0;
@@ -1102,7 +1100,7 @@ package body Wisi is
(File_Name => Data.Lexer.File_Name,
Line => Name_Token.Line,
Column => Name_Token.Column,
- Message => "wisi-name-action: name set twice.");
+ Message => Trimmed_Image (Tree.Production_ID (Nonterm)) & ":
wisi-name-action: name set twice.");
else
Data.Name_Caches.Insert (Name_Token.Char_Region);
end if;
@@ -1116,7 +1114,6 @@ package body Wisi is
Tokens : in Syntax_Trees.Valid_Node_Index_Array;
Params : in Motion_Param_Array)
is
- -- [2] wisi-motion-action
use Navigate_Cache_Trees;
Start : Nil_Buffer_Pos := (Set => False);
@@ -1257,7 +1254,7 @@ package body Wisi is
Suf_Cache : Face_Cache_Type renames
Data.Face_Caches (Suffix_Cur);
begin
if Suffix = Suf_Cache.Class and
- Inside (Suf_Cache.Region.First,
Token.Char_Region)
+ Inside (Suf_Cache.Char_Region.First,
Token.Char_Region)
then
Suf_Cache.Face := (True, Param.Suffix_Face);
end if;
@@ -1284,8 +1281,6 @@ package body Wisi is
Params : in Face_Apply_Param_Array)
is
pragma Unreferenced (Nonterm);
-
- -- [2] wisi-face-apply-list-action
use Face_Cache_Trees;
Iter : constant Iterator := Data.Face_Caches.Iterate;
@@ -1299,7 +1294,7 @@ package body Wisi is
Cache_Cur := Find_In_Range (Iter, Ascending,
Token.Char_Region.First, Token.Char_Region.Last);
loop
exit when not Has_Element (Cache_Cur) or else
- Data.Face_Caches (Cache_Cur).Region.First >
Token.Char_Region.Last;
+ Data.Face_Caches (Cache_Cur).Char_Region.First >
Token.Char_Region.Last;
declare
Cache : Face_Cache_Type renames Data.Face_Caches
(Cache_Cur);
begin
@@ -1342,19 +1337,19 @@ package body Wisi is
declare
Cache : Face_Cache_Type renames Data.Face_Caches
(Cache_Cur);
Other_Cur : Cursor := Find_In_Range
- (Iter, Ascending, Cache.Region.Last + 1,
Token.Char_Region.Last);
+ (Iter, Ascending, Cache.Char_Region.Last + 1,
Token.Char_Region.Last);
Temp : Cursor;
begin
loop
exit when not Has_Element (Other_Cur) or else
- Data.Face_Caches (Other_Cur).Region.First >
Token.Char_Region.Last;
+ Data.Face_Caches (Other_Cur).Char_Region.First >
Token.Char_Region.Last;
Temp := Other_Cur;
Other_Cur := Next (Iter, Other_Cur);
Delete (Data.Face_Caches, Temp);
end loop;
- Cache.Class := Param.Class;
- Cache.Region.Last := Token.Char_Region.Last;
+ Cache.Class := Param.Class;
+ Cache.Char_Region.Last := Token.Char_Region.Last;
end;
else
Data.Face_Caches.Insert ((Token.Char_Region, Param.Class,
(Set => False)));
@@ -1372,8 +1367,6 @@ package body Wisi is
Params : in Face_Remove_Param_Array)
is
pragma Unreferenced (Nonterm);
-
- -- [2] wisi-face-remove-action
use Face_Cache_Trees;
Iter : constant Iterator := Data.Face_Caches.Iterate;
@@ -1388,7 +1381,7 @@ package body Wisi is
Cache_Cur := Find_In_Range (Iter, Ascending,
Token.Char_Region.First, Token.Char_Region.Last);
loop
exit when not Has_Element (Cache_Cur) or else
- Data.Face_Caches (Cache_Cur).Region.First >
Token.Char_Region.Last;
+ Data.Face_Caches (Cache_Cur).Char_Region.First >
Token.Char_Region.Last;
Temp := Cache_Cur;
Cache_Cur := Next (Iter, Cache_Cur);
Delete (Data.Face_Caches, Temp);
@@ -1459,7 +1452,6 @@ package body Wisi is
Ada.Text_IO.Put_Line (";; indent_action_0: " & Tree.Image (Nonterm,
Data.Descriptor.all));
end if;
- -- [2] wisi-indent-action
for I in Tokens'Range loop
if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region and
I in Params'Range -- in some translated EBNF, not every token has
an indent param
@@ -1520,7 +1512,6 @@ package body Wisi is
is
use all type Syntax_Trees.Node_Label;
begin
- -- [2] wisi-indent-action*
for I in Tokens'First .. N loop
if Tree.Label (Tokens (I)) /= Virtual_Terminal and then
Get_Aug_Token (Data, Tree, Tokens (I)).First
@@ -1931,7 +1922,7 @@ package body Wisi is
Accumulate : in Boolean)
return Delta_Type
is
- -- [2] wisi-elisp-parse--anchored-2; return an anchored delta
+ -- Return an anchored delta
use Anchor_ID_Vectors;
-- We can't use a Reference here, because the Element in reference
-- types is constrained (as are all allocated objects of access
@@ -1987,7 +1978,7 @@ package body Wisi is
is
Indenting_Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tree_Indenting);
begin
- -- [2] wisi-elisp-parse--indent-compute-delta, which evals
wisi-anchored*, wisi-hanging*.
+ -- Evaluate wisi-anchored*, wisi-hanging*.
case Param.Label is
when Simple =>
case Param.Param.Label is
@@ -2010,7 +2001,7 @@ package body Wisi is
begin
case Anchored_Label'(Param.Param.Label) is
when Anchored_0 =>
- -- [2] wisi-anchored, wisi-anchored-1
+ -- [2] wisi-anchored
return Indent_Anchored_2
(Data,
Anchor_Line => Anchor_Token.Line,
@@ -2115,10 +2106,55 @@ package body Wisi is
if Data.Indent_Comment_Col_0 then
declare
use all type Ada.Text_IO.Count;
- Indent : Boolean := True;
+
+ function Containing_Token return Base_Token_Index
+ is
+ -- Return token index of terminal containing non_grammer on
Line;
+ -- Invalid_Token_Index if none.
+ I : Line_Number_Type := Line;
+ J : Base_Token_Index;
+ begin
+ if Line < Data.Line_Begin_Token.First_Index then
+ -- Line is before first grammar token;
Leading_Non_Grammar checked
+ -- below.
+ return Invalid_Token_Index;
+ end if;
+
+ loop
+ exit when Data.Line_Begin_Token.all (I) /=
Augmented_Token_Arrays.No_Index;
+ -- No_Index means Line is in a multi-line token, which
could be a block comment.
+ I := I - 1;
+ end loop;
+
+ J := Data.Line_Begin_Token.all (I);
+ if Line in Data.Terminals (J).First_Trailing_Comment_Line ..
+ Data.Terminals (J).Last_Trailing_Comment_Line
+ then
+ return J;
+ else
+ return Invalid_Token_Index;
+ end if;
+ end Containing_Token;
+
+ Indent : Boolean := True;
+ Containing : constant Base_Token_Index := Containing_Token;
begin
- if Data.Line_Begin_Token.all (Line - 1) /=
Augmented_Token_Arrays.No_Index then
- for Tok of Data.Terminals (Data.Line_Begin_Token.all (Line -
1)).Non_Grammar loop
+ if Line < Data.Line_Begin_Token.First_Index then
+ -- Line is before the first grammar token. We may be doing
a partial
+ -- parse where the initial indent is non-zero, so we still
have to
+ -- check for column 0.
+ for Tok of Data.Leading_Non_Grammar loop
+ if Tok.Line = Line and then
+ Tok.ID in Data.First_Comment_ID .. Data.Last_Comment_ID
and then
+ Tok.Column = 0
+ then
+ Indent := False;
+ exit;
+ end if;
+ end loop;
+
+ elsif Containing /= Invalid_Token_Index then
+ for Tok of Data.Terminals (Containing).Non_Grammar loop
if Tok.Line = Line and then
Tok.ID in Data.First_Comment_ID .. Data.Last_Comment_ID
and then
Tok.Column = 0
diff --git a/wisi.ads b/wisi.ads
index d240f0a..f871888 100644
--- a/wisi.ads
+++ b/wisi.ads
@@ -10,7 +10,7 @@
--
-- [3] wisi-process-parse.el - defines elisp/process API
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -186,21 +186,17 @@ package Wisi is
----------
-- Indent
--
- -- elisp indent functions are represented by the Indent_Param type,
- -- not Ada functions. This is to get the execution time right; in
- -- elisp, the array of parameters to wisi-indent-action is not
- -- evaluated when wisi-indent-action is called; each parameter is
- -- evaluated by wisi-elisp-parse--indent-compute-delta.
+ -- Indent functions are represented by the Indent_Param type.
type Simple_Indent_Param_Label is -- not hanging
(None,
Int,
- Anchored_0, -- wisi-anchored
- Anchored_1, -- wisi-anchored%
- Anchored_2, -- wisi-anchored%-
- Anchored_3, -- wisi-anchored*
- Anchored_4, -- wisi-anchored*-
- Language -- language-specific function
+ Anchored_0, -- [2] wisi-anchored
+ Anchored_1, -- [2] wisi-anchored%
+ Anchored_2, -- [2] wisi-anchored%-
+ Anchored_3, -- [2] wisi-anchored*
+ Anchored_4, -- [2] wisi-anchored*-
+ Language -- [2] language-specific function
);
subtype Anchored_Label is Simple_Indent_Param_Label range Anchored_0 ..
Anchored_4;
@@ -250,10 +246,10 @@ package Wisi is
type Indent_Param_Label is
(Simple,
- Hanging_0, -- wisi-hanging
- Hanging_1, -- wisi-hanging-
- Hanging_2, -- wisi-hanging%
- Hanging_3 -- wisi-hanging%-
+ Hanging_0, -- [2] wisi-hanging
+ Hanging_1, -- [2] wisi-hanging-
+ Hanging_2, -- [2] wisi-hanging%
+ Hanging_3 -- [2] wisi-hanging%-
);
subtype Hanging_Label is Indent_Param_Label range Hanging_0 .. Hanging_3;
@@ -464,15 +460,15 @@ private
Nil : constant Nil_Buffer_Pos := (Set => False);
type Navigate_Cache_Type is record
- Pos : WisiToken.Buffer_Pos; -- implicit in wisi-cache
- Statement_ID : WisiToken.Token_ID; -- wisi-cache-nonterm
- ID : WisiToken.Token_ID; -- wisi-cache-token
- Length : Natural; -- wisi-cache-last
- Class : Navigate_Class_Type; -- wisi-cache-class
- Containing_Pos : Nil_Buffer_Pos; -- wisi-cache-containing
- Prev_Pos : Nil_Buffer_Pos; -- wisi-cache-prev
- Next_Pos : Nil_Buffer_Pos; -- wisi-cache-next
- End_Pos : Nil_Buffer_Pos; -- wisi-cache-end
+ Pos : WisiToken.Buffer_Pos; -- implicit in [1] wisi-cache
+ Statement_ID : WisiToken.Token_ID; -- [1] wisi-cache-nonterm
+ ID : WisiToken.Token_ID; -- [1] wisi-cache-token
+ Length : Natural; -- [1] wisi-cache-last
+ Class : Navigate_Class_Type; -- [1] wisi-cache-class
+ Containing_Pos : Nil_Buffer_Pos; -- [1] wisi-cache-containing
+ Prev_Pos : Nil_Buffer_Pos; -- [1] wisi-cache-prev
+ Next_Pos : Nil_Buffer_Pos; -- [1] wisi-cache-next
+ End_Pos : Nil_Buffer_Pos; -- [1] wisi-cache-end
end record;
function Key (Cache : in Navigate_Cache_Type) return WisiToken.Buffer_Pos
is (Cache.Pos);
@@ -500,12 +496,12 @@ private
end record;
type Face_Cache_Type is record
- Region : WisiToken.Buffer_Region;
- Class : Face_Class_Type;
- Face : Nil_Integer; -- not set, or index into *-process-faces-names
+ Char_Region : WisiToken.Buffer_Region;
+ Class : Face_Class_Type;
+ Face : Nil_Integer; -- not set, or index into
*-process-faces-names
end record;
- function Key (Cache : in Face_Cache_Type) return WisiToken.Buffer_Pos is
(Cache.Region.First);
+ function Key (Cache : in Face_Cache_Type) return WisiToken.Buffer_Pos is
(Cache.Char_Region.First);
package Face_Cache_Trees is new SAL.Gen_Unbounded_Definite_Red_Black_Trees
(Face_Cache_Type, WisiToken.Buffer_Pos);
@@ -514,8 +510,7 @@ private
package Anchor_ID_Vectors is new Ada.Containers.Vectors (Natural, Positive);
type Indent_Type (Label : Indent_Label := Not_Set) is record
- -- [2] wisi-elisp-parse--indent elements. Indent values may be
- -- negative while indents are being computed.
+ -- Indent values may be negative while indents are being computed.
case Label is
when Not_Set =>
null;
@@ -641,7 +636,6 @@ private
type Delta_Type (Label : Delta_Labels := Simple) is
record
- -- Matches DELTA input to wisi--indent-token-1
case Label is
when Simple =>
Simple_Delta : Simple_Delta_Type;
@@ -704,7 +698,6 @@ private
Offset : in Integer;
Accumulate : in Boolean)
return Delta_Type;
- -- [2] wisi-elisp-parse--anchored-2
function Indent_Compute_Delta
(Data : in out Parse_Data_Type'Class;
@@ -720,11 +713,11 @@ private
Indenting_Token : in Augmented_Token'Class;
Delta_Indent : in Delta_Type;
Indenting_Comment : in Boolean);
- -- [2] wisi-elisp-parse--indent-token-1. Sets Data.Indents, so caller
- -- may not be in a renames for a Data.Indents element.
+ -- Sets Data.Indents, so caller may not be in a renames for a
+ -- Data.Indents element.
-- Visible for language-specific children. Must match list in
- -- wisi-process-parse.el wisi-process-parse--execute.
+ -- [3] wisi-process-parse--execute.
Navigate_Cache_Code : constant String := "1";
Face_Property_Code : constant String := "2";
Indent_Code : constant String := "3";
diff --git a/wisi.el b/wisi.el
index a7a2fbf..6cdf2b5 100644
--- a/wisi.el
+++ b/wisi.el
@@ -1,13 +1,13 @@
;;; wisi.el --- Utilities for implementing an indentation/navigation engine
using a generalized LALR parser -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2012 - 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2020 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: parser
;; indentation
;; navigation
-;; Version: 2.2.1
+;; Version: 3.0.1
;; package-requires: ((emacs "25.0") (seq "2.20"))
;; URL: http://stephe-leake.org/ada/wisitoken.html
;;
@@ -127,11 +127,6 @@ deeply nested statement, but worse in some situations."
:group 'wisi
:safe 'integerp)
-(defvar wisi-inhibit-parse nil
- "When non-nil, don't run the parser.
-Language code can set this non-nil when syntax is known to be
-invalid temporarily, or when making lots of changes.")
-
(defcustom wisi-disable-face nil
"When non-nil, `wisi-setup' does not enable use of parser for font-lock.
Useful when debugging parser or parser actions."
@@ -145,6 +140,11 @@ Useful when debugging parser or parser actions."
(defvar wisi-error-buffer nil
"Buffer for displaying syntax errors.")
+(defvar wisi-inhibit-parse nil
+ "When non-nil, don't run the parser.
+Language code can set this non-nil when syntax is known to be
+invalid temporarily, or when making lots of changes.")
+
(defun wisi-safe-marker-pos (pos)
"Return an integer buffer position from POS, an integer or marker"
(cond
@@ -153,6 +153,61 @@ Useful when debugging parser or parser actions."
(t pos)))
+;;;; misc
+
+(defun wisi-in-paren-p (&optional parse-result)
+ "Return t if point is inside a pair of parentheses.
+If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
+ (> (nth 0 (or parse-result (syntax-ppss))) 0))
+
+(defun wisi-pos-in-paren-p (pos)
+ "Return t if POS is inside a pair of parentheses."
+ (save-excursion
+ (> (nth 0 (syntax-ppss pos)) 0)))
+
+(defun wisi-same-paren-depth-p (pos1 pos2)
+ "Return t if POS1 is at same parentheses depth as POS2."
+ (= (nth 0 (syntax-ppss pos1)) (nth 0 (syntax-ppss pos2))))
+
+(defun wisi-goto-open-paren (&optional offset parse-result)
+ "Move point to innermost opening paren surrounding current point, plus
OFFSET.
+Throw error if not in paren. If PARSE-RESULT is non-nil, use it
+instead of calling `syntax-ppss'."
+ (goto-char (+ (or offset 0) (nth 1 (or parse-result (syntax-ppss))))))
+
+(defun wisi-in-comment-p (&optional parse-result)
+ "Return t if inside a comment.
+If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
+ (nth 4 (or parse-result (syntax-ppss))))
+
+(defun wisi-in-string-p (&optional parse-result)
+ "Return t if point is inside a string.
+If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
+ (nth 3 (or parse-result (syntax-ppss))))
+
+(defun wisi-in-string-or-comment-p (&optional parse-result)
+ "Return t if inside a comment or string.
+If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
+ (setq parse-result (or parse-result (syntax-ppss)))
+ (or (wisi-in-string-p parse-result) (wisi-in-comment-p parse-result)))
+
+(defun wisi-indent-newline-indent ()
+ "insert a newline, indent the old and new lines."
+ (interactive "*")
+ ;; point may be in the middle of a word, so insert newline first,
+ ;; then go back and indent.
+ (insert "\n")
+ (unless (and (wisi-partial-parse-p (line-beginning-position)
(line-end-position))
+ (save-excursion (progn (forward-char -1)(looking-back
"begin\\|else" (line-beginning-position)))))
+ ;; Partial parse may think 'begin' is just the start of a
+ ;; statement, when it's actually part of a larger declaration. So
+ ;; don't indent 'begin'. Similarly for 'else'; error recovery will
+ ;; probably insert 'if then' immediately before it
+ (forward-char -1)
+ (funcall indent-line-function)
+ (forward-char 1))
+ (funcall indent-line-function))
+
;;;; token info cache
(defvar-local wisi-parse-failed nil
@@ -634,8 +689,10 @@ Used to ignore whitespace changes in before/after change
hooks.")
;; else show all errors in a ’compilation’ buffer
(setq wisi-error-buffer (get-buffer-create wisi-error-buffer-name))
- (let ((lexer-errs (nreverse (cl-copy-seq (wisi-parser-lexer-errors
wisi--parser))))
- (parse-errs (nreverse (cl-copy-seq (wisi-parser-parse-errors
wisi--parser))))
+ (let ((lexer-errs (sort (cl-copy-seq (wisi-parser-lexer-errors
wisi--parser))
+ (lambda (a b) (< (wisi--parse-error-pos a)
(wisi--parse-error-pos b)))))
+ (parse-errs (sort (cl-copy-seq (wisi-parser-parse-errors
wisi--parser))
+ (lambda (a b) (< (wisi--parse-error-pos a)
(wisi--parse-error-pos b)))))
(dir default-directory))
(with-current-buffer wisi-error-buffer
(setq window-size-fixed nil)
@@ -690,9 +747,7 @@ Usefull if the parser appears to be hung."
(interactive)
(wisi-parse-kill wisi--parser)
;; also force re-parse
- (dolist (parse-action '(face navigate indent))
- (wisi-set-parse-try t parse-action)
- (wisi-invalidate-cache parse-action (point-min)))
+ (wisi-reset-parser)
)
(defun wisi-partial-parse-p (begin end)
@@ -1029,6 +1084,18 @@ Return start cache."
(wisi-goto-end-1 cache))
))
+(defun wisi-goto-containing-statement-start ()
+ "Move point to the start of the statement containing the current statement."
+ (interactive)
+ (wisi-validate-cache (point-min) (point-max) t 'navigate)
+ (let ((cache (or (wisi-get-cache (point))
+ (wisi-backward-cache))))
+ (when cache
+ (setq cache (wisi-goto-start cache)))
+ (when cache
+ (setq cache (wisi-goto-containing cache nil)))
+ ))
+
(defun wisi-next-statement-cache (cache)
"Move point to CACHE-next, return cache; error if nil."
(when (not (markerp (wisi-cache-next cache)))
@@ -1096,6 +1163,27 @@ the comment on the previous line."
))
)))
+(defun wisi-indent-containing-statement ()
+ "Indent region given by `wisi-goto-containing-statement-start',
`wisi-cache-end'."
+ (interactive)
+ (wisi-validate-cache (point-min) (point-max) t 'navigate)
+
+ (save-excursion
+ (let ((cache (or (wisi-get-cache (point))
+ (wisi-backward-cache))))
+ (when cache
+ ;; can be nil if in header comment
+ (let ((start (progn
+ (setq cache (wisi-goto-containing (wisi-goto-start
cache)))
+ (point)))
+ (end (if (wisi-cache-end cache)
+ ;; nil when cache is statement-end
+ (wisi-cache-end cache)
+ (point))))
+ (indent-region start end)
+ ))
+ )))
+
(defvar-local wisi-indent-calculate-functions nil
"Functions to compute indentation special cases.
Called with point at current indentation of a line; return
@@ -1125,8 +1213,10 @@ Called with BEGIN END.")
(let ((col (current-column)))
(while (and (not (eobp))
(< (point) end))
- (forward-line 1)
- (indent-line-to col)
+ (if (= 1 (forward-line 1))
+ (indent-line-to col)
+ ;; on last line of buffer; terminate loop
+ (goto-char (point-max)))
(when (bobp)
;; single line in buffer; terminate loop
(goto-char (point-max))))))
@@ -1168,100 +1258,109 @@ for parse errors. BEGIN, END is the parsed region."
"For `indent-region-function', using the wisi indentation engine.
If INDENT-BLANK-LINES is non-nil, also indent blank lines (for use as
`indent-line-function')."
- (when (< 0 wisi-debug)
- (message "wisi-indent-region %d %d"
- (wisi-safe-marker-pos begin)
- (wisi-safe-marker-pos end)))
+ (if wisi-inhibit-parse
+ (when (< 0 wisi-debug)
+ (message "wisi-indent-region %d %d skipped; wisi-inhibit-parse"
+ (wisi-safe-marker-pos begin)
+ (wisi-safe-marker-pos end)))
- (let ((wisi--parse-action 'indent)
- (parse-required nil)
- (end-mark (copy-marker end))
- (prev-indent-failed wisi-indent-failed))
+ (let ((wisi--parse-action 'indent)
+ (parse-required nil)
+ (end-mark (copy-marker end))
+ (prev-indent-failed wisi-indent-failed))
- (wisi--check-change)
+ (when (< 0 wisi-debug)
+ (message "wisi-indent-region %d %d"
+ (wisi-safe-marker-pos begin)
+ (wisi-safe-marker-pos end)))
- ;; BEGIN is inclusive; END is exclusive.
- (save-excursion
- (goto-char begin)
- (setq begin (line-beginning-position))
-
- (when (bobp) (forward-line))
- (while (and (not parse-required)
- (or (and (= begin end) (= (point) end))
- (< (point) end))
- (not (eobp)))
- (unless (get-text-property (1- (point)) 'wisi-indent)
- (setq parse-required t))
- (forward-line))
- )
-
- ;; A parse either succeeds and sets the indent cache on all
- ;; lines in the parsed region, or fails and leaves valid caches
- ;; untouched.
- (when (and parse-required
- (or (not wisi-parse-failed)
- (wisi-parse-try 'indent)))
-
- (wisi-set-parse-try nil)
- (wisi--run-parse begin end)
-
- ;; If there were errors corrected, the indentation is
- ;; potentially ambiguous; see
- ;; test/ada_mode-interactive_2.adb. Or it was a partial parse,
- ;; where errors producing bad indent are pretty much expected.
- (unless (wisi-partial-parse-p begin end)
- (setq wisi-indent-failed (< 0 (+ (length (wisi-parser-lexer-errors
wisi--parser))
- (length (wisi-parser-parse-errors
wisi--parser))))))
- )
-
- (if wisi-parse-failed
- (progn
- ;; primary indent failed
- (setq wisi-indent-failed t)
- (when (functionp wisi-indent-region-fallback)
- (when (< 0 wisi-debug)
- (message "wisi-indent-region fallback"))
- (funcall wisi-indent-region-fallback begin end)))
+ (wisi--check-change)
+ ;; BEGIN is inclusive; END is exclusive.
(save-excursion
- ;; Apply cached indents.
(goto-char begin)
- (let ((wisi-indenting-p t))
- (while (and (not (eobp))
- (or (and (= begin end) (= (point) end))
- (< (point) end-mark))) ;; end-mark is exclusive
- (when (or indent-blank-lines (not (eolp)))
- ;; ’indent-region’ doesn’t indent an empty line; ’indent-line’
does
- (let ((indent (if (bobp) 0 (wisi--get-cached-indent begin end))))
- (indent-line-to indent))
- )
- (forward-line 1))
-
- ;; Run wisi-indent-calculate-functions
- (when wisi-indent-calculate-functions
- (goto-char begin)
- (while (and (not (eobp))
- (< (point) end-mark))
- (back-to-indentation)
- (let ((indent
- (run-hook-with-args-until-success
'wisi-indent-calculate-functions)))
- (when indent
- (indent-line-to indent)))
-
- (forward-line 1)))
- )
+ (setq begin (line-beginning-position))
+
+ (when (bobp) (forward-line))
+ (while (and (not parse-required)
+ (or (and (= begin end) (= (point) end))
+ (< (point) end))
+ (not (eobp)))
+ (unless (get-text-property (1- (point)) 'wisi-indent)
+ (setq parse-required t))
+ (forward-line))
+ )
- (when
- (and prev-indent-failed
- (not wisi-indent-failed))
- ;; Previous parse failed or indent was potentially
- ;; ambiguous, this one is not.
- (goto-char end-mark)
- (when (< 0 wisi-debug)
- (message "wisi-indent-region post-parse-fail-hook"))
- (run-hooks 'wisi-post-indent-fail-hook))
- ))
- ))
+ ;; A parse either succeeds and sets the indent cache on all
+ ;; lines in the parsed region, or fails and leaves valid caches
+ ;; untouched.
+ (when (and parse-required
+ (or (not wisi-parse-failed)
+ (wisi-parse-try 'indent)))
+
+ (wisi-set-parse-try nil)
+ (wisi--run-parse begin end)
+
+ ;; If there were errors corrected, the indentation is
+ ;; potentially ambiguous; see
+ ;; test/ada_mode-interactive_2.adb. Or it was a partial parse,
+ ;; where errors producing bad indent are pretty much expected.
+ (unless (wisi-partial-parse-p begin end)
+ (setq wisi-indent-failed (< 0 (+ (length (wisi-parser-lexer-errors
wisi--parser))
+ (length (wisi-parser-parse-errors
wisi--parser))))))
+ )
+
+ (if wisi-parse-failed
+ (progn
+ ;; primary indent failed
+ (setq wisi-indent-failed t)
+ (when (functionp wisi-indent-region-fallback)
+ (when (< 0 wisi-debug)
+ (message "wisi-indent-region fallback"))
+ (funcall wisi-indent-region-fallback begin end)))
+
+ (save-excursion
+ ;; Apply cached indents. Start from end, so indenting
+ ;; doesn't affect correcting for errors in
+ ;; wisi--get-cached-indent.
+ (goto-char (1- end)) ;; end is exclusive
+ (goto-char (line-beginning-position))
+ (let ((wisi-indenting-p t))
+ (while (and (not (bobp))
+ (or (and (= begin end) (= (point) end))
+ (>= (point) begin)))
+ (when (or indent-blank-lines (not (eolp)))
+ ;; ’indent-region’ doesn’t indent an empty line; ’indent-line’
does
+ (let ((indent (if (bobp) 0 (wisi--get-cached-indent begin
end))))
+ (indent-line-to indent))
+ )
+ (forward-line -1))
+
+ ;; Run wisi-indent-calculate-functions
+ (when wisi-indent-calculate-functions
+ (goto-char begin)
+ (while (and (not (eobp))
+ (< (point) end-mark))
+ (back-to-indentation)
+ (let ((indent
+ (run-hook-with-args-until-success
'wisi-indent-calculate-functions)))
+ (when indent
+ (indent-line-to indent)))
+
+ (forward-line 1)))
+ )
+
+ (when
+ (and prev-indent-failed
+ (not wisi-indent-failed))
+ ;; Previous parse failed or indent was potentially
+ ;; ambiguous, this one is not.
+ (goto-char end-mark)
+ (when (< 0 wisi-debug)
+ (message "wisi-indent-region post-parse-fail-hook"))
+ (run-hooks 'wisi-post-indent-fail-hook))
+ ))
+ )))
(defun wisi-indent-line ()
"For `indent-line-function'."
@@ -1271,7 +1370,7 @@ If INDENT-BLANK-LINES is non-nil, also indent blank lines
(for use as
(when (>= (point) savep)
(setq to-indent t))
- (wisi-indent-region (line-beginning-position (-
wisi-indent-context-lines)) (1+ (line-end-position)) t)
+ (wisi-indent-region (line-beginning-position (1+ (-
wisi-indent-context-lines))) (1+ (line-end-position)) t)
(goto-char savep)
(when to-indent (back-to-indentation))
@@ -1286,12 +1385,18 @@ If INDENT-BLANK-LINES is non-nil, also indent blank
lines (for use as
(insert (wisi--lexer-error-inserted data)))
((wisi--parse-error-p data)
(dolist (repair (wisi--parse-error-repair data))
+ (goto-char (wisi--parse-error-repair-pos repair))
(when (< 0 (length (wisi--parse-error-repair-deleted repair)))
(delete-region (car (wisi--parse-error-repair-deleted-region repair))
- (cdr (wisi--parse-error-repair-deleted-region
repair))))
+ (cdr (wisi--parse-error-repair-deleted-region repair)))
+ (when (= ? (char-after (point)))
+ (delete-char 1)))
(dolist (id (wisi--parse-error-repair-inserted repair))
- (insert (cdr (assoc id (wisi-parser-repair-image wisi--parser))))
- (insert " "))
+ (when (and (not (bobp))
+ (not (= ?\( (char-before (point))))
+ (member (syntax-class (syntax-after (1- (point)))) '(2
3))) ;; word or symbol
+ (insert " "))
+ (insert (cdr (assoc id (wisi-parser-repair-image wisi--parser)))))
))
)))
@@ -1302,7 +1407,6 @@ If INDENT-BLANK-LINES is non-nil, also indent blank lines
(for use as
(if (= 1 (+ (length (wisi-parser-lexer-errors wisi--parser))
(length (wisi-parser-parse-errors wisi--parser))))
(progn
- (wisi-goto-error)
(wisi-repair-error-1 (or (car (wisi-parser-lexer-errors wisi--parser))
(car (wisi-parser-parse-errors
wisi--parser)))))
(if (buffer-live-p wisi-error-buffer)
@@ -1339,14 +1443,16 @@ If non-nil, only repair errors in BEG END region."
"Match line number encoded into identifier by
`wisi-xref-identifier-at-point'.")
(defun wisi-xref-ident-make (identifier &optional other-function)
+ "Return an xref-item for IDENTIFIER."
(let* ((t-prop (get-text-property 0 'xref-identifier identifier))
;; If t-prop is non-nil: identifier is from
;; identifier-at-point, the desired location is the ’other’
;; (spec/body).
;;
;; If t-prop is nil: identifier is from prompt/completion,
- ;; the line number may be included in the identifier
- ;; wrapped in <>, and the desired file is the current file.
+ ;; the line number may be included in the identifier wrapped
+ ;; in <>, and the desired location is that line in the current
+ ;; file.
(ident
(if t-prop
(substring-no-properties identifier 0 nil)
@@ -1371,9 +1477,47 @@ If non-nil, only repair errors in BEG END region."
(if t-prop
(funcall other-function ident file line column)
- (list (xref-make ident (xref-make-file-location file (or line 1)
column)))
+ (xref-make ident (xref-make-file-location file (or line 1) column))
)))
+(defun wisi-xref-item (identifier)
+ "Given IDENTIFIER, return an xref-item, with line, column nil if unknown.
+IDENTIFIER is from a user prompt with completion, or from
+`xref-backend-identifier-at-point'."
+ (let* ((t-prop (get-text-property 0 'xref-identifier identifier))
+ ;; If t-prop is non-nil: identifier is from
+ ;; identifier-at-point.
+ ;;
+ ;; If t-prop is nil: identifier is from prompt/completion,
+ ;; the line number may be included in the identifier
+ ;; wrapped in <>.
+ (ident
+ (if t-prop
+ (substring-no-properties identifier 0 nil)
+ (string-match wisi-xref-ident-regexp identifier)
+ (match-string 1 identifier)
+ ))
+ (file
+ (if t-prop
+ (plist-get t-prop ':file)
+ (buffer-file-name)))
+ (line
+ (if t-prop
+ (plist-get t-prop ':line)
+ (when (match-string 2 identifier)
+ (string-to-number (match-string 2 identifier)))))
+ (column
+ (when t-prop
+ (plist-get t-prop ':column)))
+ )
+
+ (unless (file-name-absolute-p file)
+ (setq file (locate-file file compilation-search-path)))
+
+ (let ((eieio-skip-typecheck t)) ;; allow line, column nil.
+ (xref-make ident (xref-make-file-location file line column)))
+ ))
+
(defun wisi-xref-identifier-at-point ()
(let ((ident (thing-at-point 'symbol)))
(when ident
@@ -1414,45 +1558,57 @@ If non-nil, only repair errors in BEG END region."
(let ((region (wisi-prev-name-region)))
(buffer-substring-no-properties (car region) (cdr region))))
-(defun wisi-xref-identifier-completion-table ()
- (wisi-validate-cache (point-min) (point-max) t 'navigate)
- (let ((table nil)
- (pos (point-min))
- end-pos)
- (while (setq pos (next-single-property-change pos 'wisi-name))
- ;; We can’t store location data in a string text property -
- ;; it does not survive completion. So we include the line
- ;; number in the identifier string. This also serves to
- ;; disambiguate overloaded identifiers.
- (setq end-pos (next-single-property-change pos 'wisi-name))
- (push
- (format "%s<%d>"
- (buffer-substring-no-properties pos end-pos)
- (line-number-at-pos pos))
- table)
- (setq pos end-pos)
- )
- table))
+(defun wisi-names (append-lines)
+ "List of names; each is text from one 'wisi-name property in current buffer.
+If APPEND-LINES is non-nil, each has the line number it occurs on appended."
+ (when wisi--parser
+ ;; wisi--parser is nil in a non-language buffer, like Makefile
+ (wisi-validate-cache (point-min) (point-max) t 'navigate)
+ (let ((table nil)
+ (pos (point-min))
+ end-pos)
+ (while (setq pos (next-single-property-change pos 'wisi-name))
+ ;; We can’t store location data in a string text property -
+ ;; it does not survive completion. So we include the line
+ ;; number in the identifier string. This also serves to
+ ;; disambiguate overloaded identifiers in the user interface.
+ (setq end-pos (next-single-property-change pos 'wisi-name))
+ (push
+ (if append-lines
+ (format "%s<%d>"
+ (buffer-substring-no-properties pos end-pos)
+ (line-number-at-pos pos))
+ (buffer-substring-no-properties pos end-pos))
+ table)
+ (setq pos end-pos)
+ )
+ table)))
;;;; debugging
-(defun wisi-show-region (string)
- (interactive "Mregion: ")
- (when (not (= ?\( (aref string 0)))
- (setq string (concat "(" string ")")))
+(defun wisi-show-region ()
+ (interactive)
+ (cond
+ ((use-region-p)
+ (message "(%s . %s)" (region-beginning) (region-end)))
+ (t
+ (let ((string (read-from-minibuffer "region: ")))
+ (when (not (= ?\( (aref string 0)))
+ (setq string (concat "(" string ")")))
- (let ((region (read string)))
- (cond
- ((consp (cdr region))
- ;; region is a list; (begin end)
- (set-mark (nth 0 region))
- (goto-char (nth 1 region)))
-
- ((consp region)
- ;; region is a cons; (begin . end)
- (set-mark (car region))
- (goto-char (cdr region)))
- )))
+ (let ((region (read string)))
+ (cond
+ ((consp (cdr region))
+ ;; region is a list; (begin end)
+ (set-mark (nth 0 region))
+ (goto-char (nth 1 region)))
+
+ ((consp region)
+ ;; region is a cons; (begin . end)
+ (set-mark (car region))
+ (goto-char (cdr region)))
+ ))))
+ ))
(defun wisi-debug-keys ()
"Add debug key definitions to `global-map'."
@@ -1486,7 +1642,7 @@ If non-nil, only repair errors in BEG END region."
'font-lock-face nil
'fontified nil)))
(wisi-validate-cache begin end t parse-action)
- (when (fboundp 'font-lock-ensure) (font-lock-ensure))) ;; emacs < 25
+ (font-lock-ensure))
(navigate
(wisi-validate-cache begin end t parse-action))
@@ -1602,7 +1758,7 @@ If non-nil, only repair errors in BEG END region."
(cons 'navigate nil)
(cons 'indent nil)))
- ;; file local variables may have added opentoken, gnatprep
+ ;; file local variables may have modified wisi-indent-calculate-functions
(setq wisi-indent-calculate-functions (append
wisi-indent-calculate-functions indent-calculate))
(set (make-local-variable 'indent-line-function) #'wisi-indent-line)
(set (make-local-variable 'indent-region-function) #'wisi-indent-region)
@@ -1615,18 +1771,14 @@ If non-nil, only repair errors in BEG END region."
(add-hook 'after-change-functions #'wisi-after-change nil t)
(setq wisi--change-end (copy-marker (point-min) t))
- ;; See comments above on syntax-propertize.
- (when (< emacs-major-version 25) (syntax-propertize (point-max)))
+ (set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
- ;; In Emacs >= 26, ‘run-mode-hooks’ (in the major mode function)
- ;; runs ‘hack-local-variables’ after ’*-mode-hooks’; we need
- ;; ‘wisi-post-local-vars’ to run after ‘hack-local-variables’.
(add-hook 'hack-local-variables-hook 'wisi-post-local-vars nil t)
)
(defun wisi-post-local-vars ()
"See wisi-setup."
- (setq hack-local-variables-hook (delq 'wisi-post-local-vars
hack-local-variables-hook))
+ (remove-hook 'hack-local-variables-hook #'wisi-post-local-vars)
(unless wisi-disable-face
(jit-lock-register #'wisi-fontify-region)))
diff --git a/wisi.gpr b/wisi.gpr.gp
similarity index 93%
rename from wisi.gpr
rename to wisi.gpr.gp
index 27e890d..1c17529 100644
--- a/wisi.gpr
+++ b/wisi.gpr.gp
@@ -1,6 +1,7 @@
-- Abstract :
--
--- Make installed ELPA package wisi Ada code available for other projects.
+-- Make installed and source ELPA package wisi Ada code available for
+-- other projects.
--
-- Copyright (C) 2017, 2019 Free Software Foundation, Inc.
--
@@ -18,6 +19,10 @@
with "gnatcoll";
with "standard_common";
+#if ELPA="no"
+with "sal";
+with "wisitoken";
+#end if;
project Wisi is
for Source_Dirs use (".");
diff --git a/wisitoken-bnf-generate.adb b/wisitoken-bnf-generate.adb
index 72a0221..a7616b4 100644
--- a/wisitoken-bnf-generate.adb
+++ b/wisitoken-bnf-generate.adb
@@ -52,7 +52,7 @@ is
begin
-- verbosity meaning is actually determined by output choice;
-- they should be consistent with this description.
- Put_Line (Standard_Error, "version 1.3.0");
+ Put_Line (Standard_Error, "version 1.3.1");
Put_Line (Standard_Error, "wisitoken-bnf-generate [options] {wisi
grammar file}");
Put_Line (Standard_Error, "Generate source code implementing a parser
for the grammar.");
New_Line (Standard_Error);
diff --git a/wisitoken-bnf-output_ada_common.adb
b/wisitoken-bnf-output_ada_common.adb
index 97ec9ed..ed4ef64 100644
--- a/wisitoken-bnf-output_ada_common.adb
+++ b/wisitoken-bnf-output_ada_common.adb
@@ -1008,7 +1008,7 @@ package body WisiToken.BNF.Output_Ada_Common is
Indent_Line ("result->buffer_last = input + length - 1;");
Indent_Line ("result->cursor = input;");
Indent_Line ("result->byte_token_start = input;");
- Indent_Line ("result->char_pos = 1;");
+ Indent_Line ("result->char_pos = 1; /* match
WisiToken.Buffer_Region */");
Indent_Line ("result->char_token_start = 1;");
Indent_Line ("result->line = (*result->cursor == 0x0A) ? 2
: 1;");
Indent_Line ("result->line_token_start = result->line;");
@@ -1064,19 +1064,23 @@ package body WisiToken.BNF.Output_Ada_Common is
Indent_Line ("#define YYPEEK() (lexer->cursor <= lexer->buffer_last) ?
*lexer->cursor : 4");
New_Line;
- -- Don't count UTF-8 continuation bytes, or first byte of DOS newline
- Indent_Line ("#define DO_COUNT ((*lexer->cursor & 0xC0) != 0xC0) &&
(*lexer->cursor != 0x0D)");
- New_Line;
-
Indent_Line ("static void skip(wisi_lexer* lexer)");
Indent_Line ("{");
Indent := Indent + 3;
Indent_Line ("if (lexer->cursor <= lexer->buffer_last)");
- Indent_Line ("{");
Indent_Line (" ++lexer->cursor;");
- Indent_Line (" if (DO_COUNT) ++lexer->char_pos;");
- Indent_Line (" if (lexer->cursor <= lexer->buffer_last)");
- Indent_Line (" if (*lexer->cursor == 0x0A) ++lexer->line;");
+ Indent_Line ("if (lexer->cursor <= lexer->buffer_last)");
+ Indent_Line ("{");
+ Indent_Line (" /* UFT-8 encoding:
https://en.wikipedia.org/wiki/UTF-8#Description */");
+ Indent_Line (" if (*lexer->cursor == 0x0A && lexer->cursor >
lexer->buffer && *(lexer->cursor - 1) == 0x0D)");
+ Indent_Line (" {/* second byte of DOS line ending */");
+ Indent_Line (" }");
+ Indent_Line (" else if ((*lexer->cursor & 0x80) == 0x80 &&
(*lexer->cursor & 0xC0) != 0xC0)");
+ Indent_Line (" {/* byte 2, 3 or 4 of multi-byte UTF-8 char */");
+ Indent_Line (" }");
+ Indent_Line (" else");
+ Indent_Line (" ++lexer->char_pos;");
+ Indent_Line (" if (*lexer->cursor == 0x0A) ++lexer->line;");
Indent_Line ("}");
Indent := Indent - 3;
Indent_Line ("}");
@@ -1232,17 +1236,15 @@ package body WisiToken.BNF.Output_Ada_Common is
Indent_Line ("* {status = ERROR_unrecognized_character; continue;}");
Put_Line ("*/");
- Indent_Line ("}");
Indent := Indent - 3;
+ Indent_Line ("}");
+ Indent_Line ("/* lexer->cursor and lexer ->char_pos are one char past
end of token */");
Indent_Line ("*byte_position = lexer->byte_token_start - lexer->buffer +
1;");
Indent_Line ("*byte_length = lexer->cursor -
lexer->byte_token_start;");
Indent_Line ("*char_position = lexer->char_token_start;");
- Indent_Line ("if (DO_COUNT)");
- Indent_Line (" *char_length = lexer->char_pos -
lexer->char_token_start;");
- Indent_Line ("else");
- Indent_Line (" *char_length = lexer->char_pos -
lexer->char_token_start + 1;");
- Indent_Line ("*line_start = lexer->line_token_start;");
+ Indent_Line ("*char_length = lexer->char_pos -
lexer->char_token_start;");
+ Indent_Line ("*line_start = lexer->line_token_start;");
Indent_Line ("return status;");
Indent_Line ("}");
Indent := Indent - 3;
diff --git a/wisitoken-parse-lr-mckenzie_recover-explore.adb
b/wisitoken-parse-lr-mckenzie_recover-explore.adb
index f749cfb..b6c9e43 100644
--- a/wisitoken-parse-lr-mckenzie_recover-explore.adb
+++ b/wisitoken-parse-lr-mckenzie_recover-explore.adb
@@ -546,7 +546,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
New_Config.Current_Shared_Token := Token.Min_Terminal_Index;
end if;
end if;
- New_Config.Strategy_Counts (Explore_Table) :=
New_Config.Strategy_Counts (Explore_Table) + 1;
+ New_Config.Strategy_Counts (Push_Back) :=
New_Config.Strategy_Counts (Push_Back) + 1;
Local_Config_Heap.Add (New_Config);
@@ -613,7 +613,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
else
Append (New_Config.Ops, (Undo_Reduce, Token.ID, Token_Count));
end if;
- New_Config.Strategy_Counts (Explore_Table) :=
New_Config.Strategy_Counts (Explore_Table) + 1;
+ New_Config.Strategy_Counts (Undo_Reduce) :=
New_Config.Strategy_Counts (Undo_Reduce) + 1;
Local_Config_Heap.Add (New_Config);
@@ -695,7 +695,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Do_Shift
("Insert", Super, Shared, Parser_Index,
Local_Config_Heap, New_Config, Action.State, ID,
Cost_Delta => 0,
- Strategy => Explore_Table);
+ Strategy => Insert);
end;
when Reduce =>
@@ -714,7 +714,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Do_Reduce_2
("Insert", Super, Shared, Parser_Index,
Local_Config_Heap, New_Config, ID,
Cost_Delta => 0,
- Strategy => Explore_Table);
+ Strategy => Insert);
end;
else
@@ -724,7 +724,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Do_Reduce_2
("Insert", Super, Shared, Parser_Index,
Local_Config_Heap, New_Config, ID,
Cost_Delta => 0,
- Strategy => Explore_Table);
+ Strategy => Insert);
end;
end if;
@@ -1520,7 +1520,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
New_Config.Check_Status := (Label =>
WisiToken.Semantic_Checks.Ok);
New_Config.Cost := New_Config.Cost + McKenzie_Param.Delete (ID);
- New_Config.Strategy_Counts (Explore_Table) :=
Config.Strategy_Counts (Explore_Table) + 1;
+ New_Config.Strategy_Counts (Delete) := Config.Strategy_Counts
(Delete) + 1;
if Matching_Push_Back then
-- We are deleting a push_back; cancel the push_back cost, to
make
diff --git a/wisitoken-parse-lr-mckenzie_recover.adb
b/wisitoken-parse-lr-mckenzie_recover.adb
index c53f0ef..6fa41d8 100644
--- a/wisitoken-parse-lr-mckenzie_recover.adb
+++ b/wisitoken-parse-lr-mckenzie_recover.adb
@@ -2,7 +2,7 @@
--
-- See spec
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -245,7 +245,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
if Trace_McKenzie > Outline then
Trace.New_Line;
- Trace.Put_Line (System.Multiprocessors.CPU_Range'Image
(Worker_Tasks'Last) & " parallel tasks");
+ Trace.Put_Line (Task_Count'Image & " parallel tasks");
end if;
for I in Worker_Tasks'First .. Task_Count loop
@@ -718,8 +718,10 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
when E : others =>
if Debug_Mode then
Trace.Put (Ada.Exceptions.Exception_Name (E) & ": " &
Ada.Exceptions.Exception_Message (E));
+ raise;
+ else
+ return Fail_Programmer_Error;
end if;
- return Fail_Programmer_Error;
end Recover;
----------
@@ -921,12 +923,20 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
Config : in out Configuration;
Index : in out WisiToken.Token_Index;
ID : in Token_ID)
+ is begin
+ Check (Terminals (Index).ID, ID);
+ Delete (Terminals, Config, Index);
+ end Delete_Check;
+
+ procedure Delete
+ (Terminals : in Base_Token_Arrays.Vector;
+ Config : in out Configuration;
+ Index : in out WisiToken.Token_Index)
is
use Config_Op_Arrays;
use Sorted_Insert_Delete_Arrays;
- Op : constant Config_Op := (Delete, ID, Index);
+ Op : constant Config_Op := (Delete, Terminals (Index).ID, Index);
begin
- Check (Terminals (Index).ID, ID);
if Is_Full (Config.Ops) or Is_Full (Config.Insert_Delete) then
raise Bad_Config;
end if;
@@ -934,7 +944,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
Insert (Config.Insert_Delete, Op);
Config.Current_Insert_Delete := 1;
Index := Index + 1;
- end Delete_Check;
+ end Delete;
procedure Find_ID
(Config : in Configuration;
@@ -1057,10 +1067,22 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
end Find_Matching_Name;
procedure Insert (Config : in out Configuration; ID : in Token_ID)
+ is begin
+ Insert (Config, Config.Current_Shared_Token, ID);
+ end Insert;
+
+ procedure Insert (Config : in out Configuration; IDs : in Token_ID_Array)
+ is begin
+ for ID of IDs loop
+ Insert (Config, ID);
+ end loop;
+ end Insert;
+
+ procedure Insert (Config : in out Configuration; Index : in
WisiToken.Token_Index; ID : in Token_ID)
is
use Config_Op_Arrays;
use Sorted_Insert_Delete_Arrays;
- Op : constant Config_Op := (Insert, ID, Config.Current_Shared_Token,
Unknown_State, 0);
+ Op : constant Config_Op := (Insert, ID, Index, Unknown_State, 0);
begin
if Is_Full (Config.Ops) or Is_Full (Config.Insert_Delete) then
raise Bad_Config;
@@ -1070,13 +1092,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
Config.Current_Insert_Delete := 1;
end Insert;
- procedure Insert (Config : in out Configuration; IDs : in Token_ID_Array)
- is begin
- for ID of IDs loop
- Insert (Config, ID);
- end loop;
- end Insert;
-
function Next_Token
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in out Base_Token_Index;
diff --git a/wisitoken-parse-lr-mckenzie_recover.ads
b/wisitoken-parse-lr-mckenzie_recover.ads
index 9b84a03..dedad36 100644
--- a/wisitoken-parse-lr-mckenzie_recover.ads
+++ b/wisitoken-parse-lr-mckenzie_recover.ads
@@ -118,6 +118,12 @@ private
-- order. Increments Index, for convenience when deleting several
-- tokens.
+ procedure Delete
+ (Terminals : in Base_Token_Arrays.Vector;
+ Config : in out Configuration;
+ Index : in out WisiToken.Token_Index);
+ -- Same as Delete_Check, without the check.
+
procedure Find_ID
(Config : in Configuration;
ID : in Token_ID;
@@ -170,16 +176,19 @@ private
-- Also count tokens with ID = Other_ID.
procedure Insert (Config : in out Configuration; ID : in Token_ID);
- -- Append an Insert op to Config.Ops, and insert it in
- -- Config.Insert_Deleted in token_index order.
+ -- Append an Insert op at Config.Current_Shared_Token, to Config.Ops,
+ -- and insert it in Config.Insert_Deleted in token_index order.
procedure Insert (Config : in out Configuration; IDs : in Token_ID_Array);
-- Call Insert for each item in IDs.
+ procedure Insert (Config : in out Configuration; Index : in
WisiToken.Token_Index; ID : in Token_ID);
+ -- Same as Insert, but at Index, not Config.Current_Shared_Token.
+
function Next_Token
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in out Base_Token_Index;
- Restore_Terminals_Current : in out WisiToken.Base_Token_Index;
+ Restore_Terminals_Current : in out Base_Token_Index;
Insert_Delete : aliased in out
Sorted_Insert_Delete_Arrays.Vector;
Current_Insert_Delete : in out SAL.Base_Peek_Type;
Prev_Deleted : in
Recover_Token_Index_Arrays.Vector)
diff --git a/wisitoken-parse-lr-parser.adb b/wisitoken-parse-lr-parser.adb
index 70fab20..44c1ac0 100644
--- a/wisitoken-parse-lr-parser.adb
+++ b/wisitoken-parse-lr-parser.adb
@@ -368,13 +368,16 @@ package body WisiToken.Parse.LR.Parser is
is
use all type Syntax_Trees.User_Data_Access;
begin
- Parser.Lexer := Lexer;
- Parser.Trace := Trace;
+ Parser.Lexer := Lexer;
+ Parser.Trace := Trace;
+ Parser.User_Data := User_Data;
+
+ -- Terminals, Line_Begin_Token are initialized to empty arrays.
+
Parser.Table := Table;
Parser.Language_Fixes := Language_Fixes;
Parser.Language_Matching_Begin_Tokens := Language_Matching_Begin_Tokens;
Parser.Language_String_ID_Set := Language_String_ID_Set;
- Parser.User_Data := User_Data;
Parser.Enable_McKenzie_Recover := not McKenzie_Defaulted (Table.all);
@@ -701,18 +704,18 @@ package body WisiToken.Parse.LR.Parser is
if Ada.Text_IO.Is_Open (Shared_Parser.Recover_Log_File) then
declare
use Ada.Text_IO;
- Strategy_Counts : LR.Strategy_Counts := (others => 0);
begin
Put
(Shared_Parser.Recover_Log_File,
Ada.Calendar.Formatting.Image (Ada.Calendar.Clock)
& " " &
- McKenzie_Recover.Recover_Status'Image
(Recover_Result) & " " &
- SAL.Base_Peek_Type'Image
(Pre_Recover_Parser_Count) & " '" &
+ Shared_Parser.Partial_Parse_Active'Image & " " &
+ Recover_Result'Image & " " &
+ Pre_Recover_Parser_Count'Image & " '" &
Shared_Parser.Lexer.File_Name & "'");
Put (Shared_Parser.Recover_Log_File, '(');
for Parser of Shared_Parser.Parsers loop
- Accumulate (Parser.Recover, Strategy_Counts);
+ Put (Shared_Parser.Recover_Log_File, Image
(Parser.Recover.Results.Peek.Strategy_Counts));
Put
(Shared_Parser.Recover_Log_File,
Integer'Image (Parser.Recover.Enqueue_Count) &
@@ -721,7 +724,6 @@ package body WisiToken.Parse.LR.Parser is
end loop;
Put (Shared_Parser.Recover_Log_File, ')');
- Put (Shared_Parser.Recover_Log_File, Image
(Strategy_Counts));
New_Line (Shared_Parser.Recover_Log_File);
Flush (Shared_Parser.Recover_Log_File);
end;
@@ -1064,6 +1066,9 @@ package body WisiToken.Parse.LR.Parser is
Parser_State : Parser_Lists.Parser_State renames
Parser.Parsers.First_State_Ref;
begin
if Trace_Action > Outline then
+ if Trace_Action > Extra then
+ Parser_State.Tree.Print_Tree (Descriptor,
Parser_State.Tree.Root);
+ end if;
Parser.Trace.Put_Line
(Integer'Image (Parser_State.Label) & ": root node: " &
Parser_State.Tree.Image
(Parser_State.Tree.Root, Descriptor));
diff --git a/wisitoken-parse-lr-parser.ads b/wisitoken-parse-lr-parser.ads
index e84d65d..18f476e 100644
--- a/wisitoken-parse-lr-parser.ads
+++ b/wisitoken-parse-lr-parser.ads
@@ -109,6 +109,8 @@ package WisiToken.Parse.LR.Parser is
Terminate_Same_State : Boolean;
Enable_McKenzie_Recover : Boolean;
Recover_Log_File : Ada.Text_IO.File_Type;
+ Partial_Parse_Active : Boolean := False;
+ -- Partial_Parse_Active is only used in recover log messages.
end record;
overriding procedure Finalize (Object : in out LR.Parser.Parser);
diff --git a/wisitoken-parse-lr.ads b/wisitoken-parse-lr.ads
index 76a02d5..36f8889 100644
--- a/wisitoken-parse-lr.ads
+++ b/wisitoken-parse-lr.ads
@@ -546,7 +546,8 @@ package WisiToken.Parse.LR is
-- which is true if they were copied from the parser stack, and not
-- pushed by recover.
- type Strategies is (Language_Fix, Minimal_Complete, Matching_Begin,
Explore_Table, String_Quote);
+ type Strategies is
+ (Language_Fix, Minimal_Complete, Matching_Begin, Push_Back, Undo_Reduce,
Insert, Delete, String_Quote);
type Strategy_Counts is array (Strategies) of Natural;
function Image is new SAL.Gen_Array_Image (Strategies, Natural,
Strategy_Counts, Trimmed_Image);
diff --git a/wisitoken-parse.adb b/wisitoken-parse.adb
index ee7b1e8..3685b4e 100644
--- a/wisitoken-parse.adb
+++ b/wisitoken-parse.adb
@@ -21,6 +21,7 @@ package body WisiToken.Parse is
function Next_Grammar_Token (Parser : in out Base_Parser) return Token_ID
is
+ use all type Ada.Containers.Count_Type;
use all type Syntax_Trees.User_Data_Access;
Token : Base_Token;
@@ -38,12 +39,16 @@ package body WisiToken.Parse is
if Token.Line /= Invalid_Line_Number then
-- Some lexers don't support line numbers.
if Parser.Lexer.First then
- Parser.Line_Begin_Token.Set_First_Last (Line_Number_Type'First,
Token.Line);
+ if Parser.Line_Begin_Token.Length = 0 then
+ Parser.Line_Begin_Token.Set_First_Last (Token.Line,
Token.Line);
+ else
+ Parser.Line_Begin_Token.Set_First_Last
(Parser.Line_Begin_Token.First_Index, Token.Line);
+ end if;
Parser.Line_Begin_Token (Token.Line) :=
Parser.Terminals.Last_Index +
(if Token.ID >= Parser.Trace.Descriptor.First_Terminal then 1
else 0);
elsif Token.ID = Parser.Trace.Descriptor.EOI_ID then
- Parser.Line_Begin_Token.Set_First_Last (Line_Number_Type'First,
Token.Line + 1);
+ Parser.Line_Begin_Token.Set_First_Last
(Parser.Line_Begin_Token.First_Index, Token.Line + 1);
Parser.Line_Begin_Token (Token.Line + 1) :=
Parser.Terminals.Last_Index + 1;
end if;
end if;
diff --git a/wisitoken-parse.ads b/wisitoken-parse.ads
index c2fb500..edecb90 100644
--- a/wisitoken-parse.ads
+++ b/wisitoken-parse.ads
@@ -23,11 +23,20 @@ with WisiToken.Syntax_Trees;
package WisiToken.Parse is
type Base_Parser is abstract new Ada.Finalization.Limited_Controlled with
record
- Trace : access WisiToken.Trace'Class;
- Lexer : WisiToken.Lexer.Handle;
- User_Data : WisiToken.Syntax_Trees.User_Data_Access;
- Terminals : aliased WisiToken.Base_Token_Arrays.Vector;
+ Trace : access WisiToken.Trace'Class;
+ Lexer : WisiToken.Lexer.Handle;
+ User_Data : WisiToken.Syntax_Trees.User_Data_Access;
+ Terminals : aliased WisiToken.Base_Token_Arrays.Vector;
+
Line_Begin_Token : aliased WisiToken.Line_Begin_Token_Vectors.Vector;
+ -- Line_Begin_Token (I) is the index into Terminals of the first
+ -- grammar token on line I. Line_Begin_Token.First_Index is the first
+ -- line containing a grammar token (after leading comments). However,
+ -- if the only token on line I is a non_grammar token (ie a comment,
+ -- or a newline for a blank line), Line_Begin_Token (I) is the last
+ -- grammar token on the previous non-blank line. If Line (I) is a
+ -- non-first line in a multi-line token, Line_Begin_Token (I) is
+ -- Invalid_Token_Index.
end record;
-- Common to all parsers. Finalize should free any allocated objects.
diff --git a/wisitoken-semantic_checks.ads b/wisitoken-semantic_checks.ads
index 09517e1..c55371e 100644
--- a/wisitoken-semantic_checks.ads
+++ b/wisitoken-semantic_checks.ads
@@ -100,6 +100,7 @@ package WisiToken.Semantic_Checks is
Nonterm : in Recover_Token)
return Check_Status;
pragma Inline (Terminate_Partial_Parse);
- -- If Active, raise Wisitoken.Partial_Parse; otherwise return Ok.
+ -- If partial parse is complete, raise Wisitoken.Partial_Parse;
+ -- otherwise return Ok.
end WisiToken.Semantic_Checks;
diff --git a/wisitoken_grammar_re2c.c b/wisitoken_grammar_re2c.c
index f4185ee..ef82744 100644
--- a/wisitoken_grammar_re2c.c
+++ b/wisitoken_grammar_re2c.c
@@ -59,7 +59,7 @@ wisi_lexer* wisitoken_grammar_new_lexer
result->buffer_last = input + length - 1;
result->cursor = input;
result->byte_token_start = input;
- result->char_pos = 1;
+ result->char_pos = 1; /* match WisiToken.Buffer_Region */
result->char_token_start = 1;
result->line = (*result->cursor == 0x0A) ? 2 : 1;
result->line_token_start = result->line;
@@ -97,16 +97,22 @@ static void debug(wisi_lexer* lexer, int state, unsigned
char ch)
#define YYPEEK() (lexer->cursor <= lexer->buffer_last) ? *lexer->cursor : 4
-#define DO_COUNT ((*lexer->cursor & 0xC0) != 0xC0) && (*lexer->cursor != 0x0D)
-
static void skip(wisi_lexer* lexer)
{
if (lexer->cursor <= lexer->buffer_last)
- {
++lexer->cursor;
- if (DO_COUNT) ++lexer->char_pos;
- if (lexer->cursor <= lexer->buffer_last)
- if (*lexer->cursor == 0x0A) ++lexer->line;
+ if (lexer->cursor <= lexer->buffer_last)
+ {
+ /* UFT-8 encoding: https://en.wikipedia.org/wiki/UTF-8#Description */
+ if (*lexer->cursor == 0x0A && lexer->cursor > lexer->buffer &&
*(lexer->cursor - 1) == 0x0D)
+ {/* second byte of DOS line ending */
+ }
+ else if ((*lexer->cursor & 0x80) == 0x80 && (*lexer->cursor & 0xC0) !=
0xC0)
+ {/* byte 2, 3 or 4 of multi-byte UTF-8 char */
+ }
+ else
+ ++lexer->char_pos;
+ if (*lexer->cursor == 0x0A) ++lexer->line;
}
}
#define YYSKIP() skip(lexer)
@@ -173,7 +179,7 @@ int wisitoken_grammar_next_token
while (*id == -1 && status == 0)
{
-#line 177 "../wisitoken_grammar_re2c.c"
+#line 183 "../wisitoken_grammar_re2c.c"
{
YYCTYPE yych;
unsigned int yyaccept = 0;
@@ -326,21 +332,21 @@ yy2:
YYSKIP ();
yy3:
YYDEBUG(3, YYPEEK ());
-#line 255 "../wisitoken_grammar.re2c"
+#line 261 "../wisitoken_grammar.re2c"
{status = ERROR_unrecognized_character; continue;}
-#line 332 "../wisitoken_grammar_re2c.c"
+#line 338 "../wisitoken_grammar_re2c.c"
yy4:
YYDEBUG(4, YYPEEK ());
YYSKIP ();
YYDEBUG(5, YYPEEK ());
-#line 253 "../wisitoken_grammar.re2c"
+#line 259 "../wisitoken_grammar.re2c"
{*id = 36; continue;}
-#line 339 "../wisitoken_grammar_re2c.c"
+#line 345 "../wisitoken_grammar_re2c.c"
yy6:
YYDEBUG(6, YYPEEK ());
YYSKIP ();
YYDEBUG(7, YYPEEK ());
-#line 211 "../wisitoken_grammar.re2c"
+#line 217 "../wisitoken_grammar.re2c"
{ lexer->byte_token_start = lexer->cursor;
lexer->char_token_start = lexer->char_pos;
if (*lexer->cursor == 0x0A)
@@ -348,14 +354,14 @@ yy6:
else
lexer->line_token_start = lexer->line;
continue; }
-#line 352 "../wisitoken_grammar_re2c.c"
+#line 358 "../wisitoken_grammar_re2c.c"
yy8:
YYDEBUG(8, YYPEEK ());
YYSKIP ();
YYDEBUG(9, YYPEEK ());
-#line 218 "../wisitoken_grammar.re2c"
+#line 224 "../wisitoken_grammar.re2c"
{*id = 1; continue;}
-#line 359 "../wisitoken_grammar_re2c.c"
+#line 365 "../wisitoken_grammar_re2c.c"
yy10:
YYDEBUG(10, YYPEEK ());
YYSKIP ();
@@ -532,9 +538,9 @@ yy12:
}
yy13:
YYDEBUG(13, YYPEEK ());
-#line 240 "../wisitoken_grammar.re2c"
+#line 246 "../wisitoken_grammar.re2c"
{*id = 23; continue;}
-#line 538 "../wisitoken_grammar_re2c.c"
+#line 544 "../wisitoken_grammar_re2c.c"
yy14:
YYDEBUG(14, YYPEEK ());
yyaccept = 0;
@@ -695,37 +701,37 @@ yy15:
YYDEBUG(15, YYPEEK ());
YYSKIP ();
YYDEBUG(16, YYPEEK ());
-#line 237 "../wisitoken_grammar.re2c"
+#line 243 "../wisitoken_grammar.re2c"
{*id = 20; continue;}
-#line 701 "../wisitoken_grammar_re2c.c"
+#line 707 "../wisitoken_grammar_re2c.c"
yy17:
YYDEBUG(17, YYPEEK ());
YYSKIP ();
YYDEBUG(18, YYPEEK ());
-#line 245 "../wisitoken_grammar.re2c"
+#line 251 "../wisitoken_grammar.re2c"
{*id = 28; continue;}
-#line 708 "../wisitoken_grammar_re2c.c"
+#line 714 "../wisitoken_grammar_re2c.c"
yy19:
YYDEBUG(19, YYPEEK ());
YYSKIP ();
YYDEBUG(20, YYPEEK ());
-#line 248 "../wisitoken_grammar.re2c"
+#line 254 "../wisitoken_grammar.re2c"
{*id = 31; continue;}
-#line 715 "../wisitoken_grammar_re2c.c"
+#line 721 "../wisitoken_grammar_re2c.c"
yy21:
YYDEBUG(21, YYPEEK ());
YYSKIP ();
YYDEBUG(22, YYPEEK ());
-#line 241 "../wisitoken_grammar.re2c"
+#line 247 "../wisitoken_grammar.re2c"
{*id = 24; continue;}
-#line 722 "../wisitoken_grammar_re2c.c"
+#line 728 "../wisitoken_grammar_re2c.c"
yy23:
YYDEBUG(23, YYPEEK ());
YYSKIP ();
YYDEBUG(24, YYPEEK ());
-#line 232 "../wisitoken_grammar.re2c"
+#line 238 "../wisitoken_grammar.re2c"
{*id = 15; continue;}
-#line 729 "../wisitoken_grammar_re2c.c"
+#line 735 "../wisitoken_grammar_re2c.c"
yy25:
YYDEBUG(25, YYPEEK ());
YYSKIP ();
@@ -746,16 +752,16 @@ yy25:
}
yy26:
YYDEBUG(26, YYPEEK ());
-#line 239 "../wisitoken_grammar.re2c"
+#line 245 "../wisitoken_grammar.re2c"
{*id = 22; continue;}
-#line 752 "../wisitoken_grammar_re2c.c"
+#line 758 "../wisitoken_grammar_re2c.c"
yy27:
YYDEBUG(27, YYPEEK ());
YYSKIP ();
YYDEBUG(28, YYPEEK ());
-#line 247 "../wisitoken_grammar.re2c"
+#line 253 "../wisitoken_grammar.re2c"
{*id = 30; continue;}
-#line 759 "../wisitoken_grammar_re2c.c"
+#line 765 "../wisitoken_grammar_re2c.c"
yy29:
YYDEBUG(29, YYPEEK ());
YYSKIP ();
@@ -777,9 +783,9 @@ yy29:
}
yy31:
YYDEBUG(31, YYPEEK ());
-#line 249 "../wisitoken_grammar.re2c"
+#line 255 "../wisitoken_grammar.re2c"
{*id = 32; continue;}
-#line 783 "../wisitoken_grammar_re2c.c"
+#line 789 "../wisitoken_grammar_re2c.c"
yy32:
YYDEBUG(32, YYPEEK ());
yyaccept = 1;
@@ -792,9 +798,9 @@ yy32:
}
yy33:
YYDEBUG(33, YYPEEK ());
-#line 230 "../wisitoken_grammar.re2c"
+#line 236 "../wisitoken_grammar.re2c"
{*id = 13; continue;}
-#line 798 "../wisitoken_grammar_re2c.c"
+#line 804 "../wisitoken_grammar_re2c.c"
yy34:
YYDEBUG(34, YYPEEK ());
YYSKIP ();
@@ -805,37 +811,37 @@ yy34:
}
yy35:
YYDEBUG(35, YYPEEK ());
-#line 246 "../wisitoken_grammar.re2c"
+#line 252 "../wisitoken_grammar.re2c"
{*id = 29; continue;}
-#line 811 "../wisitoken_grammar_re2c.c"
+#line 817 "../wisitoken_grammar_re2c.c"
yy36:
YYDEBUG(36, YYPEEK ());
YYSKIP ();
YYDEBUG(37, YYPEEK ());
-#line 238 "../wisitoken_grammar.re2c"
+#line 244 "../wisitoken_grammar.re2c"
{*id = 21; continue;}
-#line 818 "../wisitoken_grammar_re2c.c"
+#line 824 "../wisitoken_grammar_re2c.c"
yy38:
YYDEBUG(38, YYPEEK ());
YYSKIP ();
YYDEBUG(39, YYPEEK ());
-#line 233 "../wisitoken_grammar.re2c"
+#line 239 "../wisitoken_grammar.re2c"
{*id = 16; continue;}
-#line 825 "../wisitoken_grammar_re2c.c"
+#line 831 "../wisitoken_grammar_re2c.c"
yy40:
YYDEBUG(40, YYPEEK ());
YYSKIP ();
YYDEBUG(41, YYPEEK ());
-#line 234 "../wisitoken_grammar.re2c"
+#line 240 "../wisitoken_grammar.re2c"
{*id = 17; continue;}
-#line 832 "../wisitoken_grammar_re2c.c"
+#line 838 "../wisitoken_grammar_re2c.c"
yy42:
YYDEBUG(42, YYPEEK ());
YYSKIP ();
YYDEBUG(43, YYPEEK ());
-#line 242 "../wisitoken_grammar.re2c"
+#line 248 "../wisitoken_grammar.re2c"
{*id = 25; continue;}
-#line 839 "../wisitoken_grammar_re2c.c"
+#line 845 "../wisitoken_grammar_re2c.c"
yy44:
YYDEBUG(44, YYPEEK ());
yyaccept = 2;
@@ -964,23 +970,23 @@ yy45:
}
yy46:
YYDEBUG(46, YYPEEK ());
-#line 250 "../wisitoken_grammar.re2c"
+#line 256 "../wisitoken_grammar.re2c"
{*id = 33; continue;}
-#line 970 "../wisitoken_grammar_re2c.c"
+#line 976 "../wisitoken_grammar_re2c.c"
yy47:
YYDEBUG(47, YYPEEK ());
YYSKIP ();
YYDEBUG(48, YYPEEK ());
-#line 236 "../wisitoken_grammar.re2c"
+#line 242 "../wisitoken_grammar.re2c"
{*id = 19; continue;}
-#line 977 "../wisitoken_grammar_re2c.c"
+#line 983 "../wisitoken_grammar_re2c.c"
yy49:
YYDEBUG(49, YYPEEK ());
YYSKIP ();
YYDEBUG(50, YYPEEK ());
-#line 244 "../wisitoken_grammar.re2c"
+#line 250 "../wisitoken_grammar.re2c"
{*id = 27; continue;}
-#line 984 "../wisitoken_grammar_re2c.c"
+#line 990 "../wisitoken_grammar_re2c.c"
yy51:
YYDEBUG(51, YYPEEK ());
yyaccept = 2;
@@ -1045,23 +1051,23 @@ yy57:
YYDEBUG(57, YYPEEK ());
YYSKIP ();
YYDEBUG(58, YYPEEK ());
-#line 235 "../wisitoken_grammar.re2c"
+#line 241 "../wisitoken_grammar.re2c"
{*id = 18; continue;}
-#line 1051 "../wisitoken_grammar_re2c.c"
+#line 1057 "../wisitoken_grammar_re2c.c"
yy59:
YYDEBUG(59, YYPEEK ());
YYSKIP ();
YYDEBUG(60, YYPEEK ());
-#line 229 "../wisitoken_grammar.re2c"
+#line 235 "../wisitoken_grammar.re2c"
{*id = 12; continue;}
-#line 1058 "../wisitoken_grammar_re2c.c"
+#line 1064 "../wisitoken_grammar_re2c.c"
yy61:
YYDEBUG(61, YYPEEK ());
YYSKIP ();
YYDEBUG(62, YYPEEK ());
-#line 243 "../wisitoken_grammar.re2c"
+#line 249 "../wisitoken_grammar.re2c"
{*id = 26; continue;}
-#line 1065 "../wisitoken_grammar_re2c.c"
+#line 1071 "../wisitoken_grammar_re2c.c"
yy63:
YYDEBUG(63, YYPEEK ());
YYSKIP ();
@@ -1587,9 +1593,9 @@ yy72:
}
yy73:
YYDEBUG(73, YYPEEK ());
-#line 251 "../wisitoken_grammar.re2c"
+#line 257 "../wisitoken_grammar.re2c"
{*id = 34; continue;}
-#line 1593 "../wisitoken_grammar_re2c.c"
+#line 1599 "../wisitoken_grammar_re2c.c"
yy74:
YYDEBUG(74, YYPEEK ());
YYSKIP ();
@@ -1924,23 +1930,23 @@ yy80:
YYDEBUG(80, YYPEEK ());
YYSKIP ();
YYDEBUG(81, YYPEEK ());
-#line 228 "../wisitoken_grammar.re2c"
+#line 234 "../wisitoken_grammar.re2c"
{*id = 11; skip_to(lexer, ")%"); continue;}
-#line 1930 "../wisitoken_grammar_re2c.c"
+#line 1936 "../wisitoken_grammar_re2c.c"
yy82:
YYDEBUG(82, YYPEEK ());
YYSKIP ();
YYDEBUG(83, YYPEEK ());
-#line 227 "../wisitoken_grammar.re2c"
+#line 233 "../wisitoken_grammar.re2c"
{*id = 10; skip_to(lexer, "]%"); continue;}
-#line 1937 "../wisitoken_grammar_re2c.c"
+#line 1943 "../wisitoken_grammar_re2c.c"
yy84:
YYDEBUG(84, YYPEEK ());
YYSKIP ();
YYDEBUG(85, YYPEEK ());
-#line 226 "../wisitoken_grammar.re2c"
+#line 232 "../wisitoken_grammar.re2c"
{*id = 9; skip_to(lexer, "}%"); continue;}
-#line 1944 "../wisitoken_grammar_re2c.c"
+#line 1950 "../wisitoken_grammar_re2c.c"
yy86:
YYDEBUG(86, YYPEEK ());
YYSKIP ();
@@ -2109,9 +2115,9 @@ yy88:
}
yy89:
YYDEBUG(89, YYPEEK ());
-#line 252 "../wisitoken_grammar.re2c"
+#line 258 "../wisitoken_grammar.re2c"
{*id = 35; continue;}
-#line 2115 "../wisitoken_grammar_re2c.c"
+#line 2121 "../wisitoken_grammar_re2c.c"
yy90:
YYDEBUG(90, YYPEEK ());
YYSKIP ();
@@ -2639,9 +2645,9 @@ yy97:
}
yy99:
YYDEBUG(99, YYPEEK ());
-#line 219 "../wisitoken_grammar.re2c"
+#line 225 "../wisitoken_grammar.re2c"
{*id = 2; continue;}
-#line 2645 "../wisitoken_grammar_re2c.c"
+#line 2651 "../wisitoken_grammar_re2c.c"
yy100:
YYDEBUG(100, YYPEEK ());
YYSKIP ();
@@ -3118,9 +3124,9 @@ yy108:
}
yy109:
YYDEBUG(109, YYPEEK ());
-#line 222 "../wisitoken_grammar.re2c"
+#line 228 "../wisitoken_grammar.re2c"
{*id = 5; continue;}
-#line 3124 "../wisitoken_grammar_re2c.c"
+#line 3130 "../wisitoken_grammar_re2c.c"
yy110:
YYDEBUG(110, YYPEEK ());
yyaccept = 2;
@@ -3155,9 +3161,9 @@ yy113:
YYDEBUG(113, YYPEEK ());
YYSKIP ();
YYDEBUG(114, YYPEEK ());
-#line 231 "../wisitoken_grammar.re2c"
+#line 237 "../wisitoken_grammar.re2c"
{*id = 14; continue;}
-#line 3161 "../wisitoken_grammar_re2c.c"
+#line 3167 "../wisitoken_grammar_re2c.c"
yy115:
YYDEBUG(115, YYPEEK ());
YYSKIP ();
@@ -3624,9 +3630,9 @@ yy122:
}
yy123:
YYDEBUG(123, YYPEEK ());
-#line 221 "../wisitoken_grammar.re2c"
+#line 227 "../wisitoken_grammar.re2c"
{*id = 4; continue;}
-#line 3630 "../wisitoken_grammar_re2c.c"
+#line 3636 "../wisitoken_grammar_re2c.c"
yy124:
YYDEBUG(124, YYPEEK ());
yyaccept = 2;
@@ -3783,9 +3789,9 @@ yy127:
}
yy128:
YYDEBUG(128, YYPEEK ());
-#line 220 "../wisitoken_grammar.re2c"
+#line 226 "../wisitoken_grammar.re2c"
{*id = 3; continue;}
-#line 3789 "../wisitoken_grammar_re2c.c"
+#line 3795 "../wisitoken_grammar_re2c.c"
yy129:
YYDEBUG(129, YYPEEK ());
yyaccept = 2;
@@ -3962,9 +3968,9 @@ yy134:
}
yy135:
YYDEBUG(135, YYPEEK ());
-#line 225 "../wisitoken_grammar.re2c"
+#line 231 "../wisitoken_grammar.re2c"
{*id = 8; continue;}
-#line 3968 "../wisitoken_grammar_re2c.c"
+#line 3974 "../wisitoken_grammar_re2c.c"
yy136:
YYDEBUG(136, YYPEEK ());
yyaccept = 2;
@@ -4111,9 +4117,9 @@ yy138:
}
yy139:
YYDEBUG(139, YYPEEK ());
-#line 223 "../wisitoken_grammar.re2c"
+#line 229 "../wisitoken_grammar.re2c"
{*id = 6; continue;}
-#line 4117 "../wisitoken_grammar_re2c.c"
+#line 4123 "../wisitoken_grammar_re2c.c"
yy140:
YYDEBUG(140, YYPEEK ());
yyaccept = 2;
@@ -4280,20 +4286,18 @@ yy144:
}
yy145:
YYDEBUG(145, YYPEEK ());
-#line 224 "../wisitoken_grammar.re2c"
+#line 230 "../wisitoken_grammar.re2c"
{*id = 7; continue;}
-#line 4286 "../wisitoken_grammar_re2c.c"
+#line 4292 "../wisitoken_grammar_re2c.c"
}
-#line 256 "../wisitoken_grammar.re2c"
+#line 262 "../wisitoken_grammar.re2c"
- }
+ }
+ /* lexer->cursor and lexer ->char_pos are one char past end of token */
*byte_position = lexer->byte_token_start - lexer->buffer + 1;
*byte_length = lexer->cursor - lexer->byte_token_start;
*char_position = lexer->char_token_start;
- if (DO_COUNT)
- *char_length = lexer->char_pos - lexer->char_token_start;
- else
- *char_length = lexer->char_pos - lexer->char_token_start + 1;
- *line_start = lexer->line_token_start;
+ *char_length = lexer->char_pos - lexer->char_token_start;
+ *line_start = lexer->line_token_start;
return status;
}
- [elpa] externals/wisi 8bdcee1 11/35: publish ada-mode 5.1.6, wisi 1.0.6, new package ada-ref-man, (continued)
- [elpa] externals/wisi 8bdcee1 11/35: publish ada-mode 5.1.6, wisi 1.0.6, new package ada-ref-man, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 364da46 20/35: Update ada-mode to version 5.2.2, wisi to version 1.1.5, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 89eee25 23/35: Release ada-mode 6.0.1, wisi 2.0.1; fix copyright, packaging bugs, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi d0eac6a 34/35: Forgot some new files in wisi, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi a6b3115 24/35: * ada-mode, wisi: Fix file access rights, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi bd1884c 02/35: Fix up copyright notices., Stefan Monnier, 2020/11/28
- [elpa] externals/wisi c282a4b 13/35: update ada-mode, wisi, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 27db81d 17/35: Fix some quoting problems in doc strings, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 724a763 31/35: In wisi sal-gen_unbounded_definite_red_black_trees.adb, correct WORKAROUND, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi abbb0c2 19/35: Release wisi 1.1.4, ada-mode 5.2.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 5becb56 29/35: Release ada-mode 7.0.1, wisi 3.0.1,
Stefan Monnier <=
- [elpa] externals/wisi 2114f5a 28/35: In ada-mode and wisi, release ada-mode 6.2.1, wisi 2.2.1; fix packaging bugs, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 2636b79 25/35: Release ada-mode 6.1.0, wisi 2.1.0, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi dd09dcf 35/35: * .gitignore: New file, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 232d669 18/35: Release: ada-mode: version 5.2.0. wisi: version 1.1.3, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi c7f61e5 26/35: In ada-mode, wisi; release ada-mode 6.1.1, wisi 2.1.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 66d7e59 27/35: In ada-mode, wisi: release Ada mode 6.2.0, wisi 1.2.0., Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 1dc8c19 12/35: release ada-mode 5.1.7, wisi 1.1.0; minor format changes in ada-ref-man (take 2), Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 5934bfc 06/35: release ada-mode 5.1.0, wisi 1.0.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi d9cd208 32/35: In ada-mode, release 7.1.3; in wisi, release 3.1.2, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi c80e75d 30/35: Release ada-mode 7.1.0, wisi 3.1.0, Stefan Monnier, 2020/11/28