[nongnu] elpa/sweeprolog 0078ef8ff0 060/166: ENHANCED: syntax errors coloring

[ELPA Syncer]

branch: elpa/sweeprolog
commit 0078ef8ff06d37b759d5f37015fade6c03d852c4
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    ENHANCED: syntax errors coloring
---
 sweep.el | 34 ++++++++++++++++++++++++++++------
 sweep.pl | 52 ++++++++++------------------------------------------
 2 files changed, 38 insertions(+), 48 deletions(-)

diff --git a/sweep.el b/sweep.el
index ec94dd4f9f..48309a2434 100644
--- a/sweep.el
+++ b/sweep.el
@@ -571,7 +571,8 @@ module name, F is a functor name and N is its arity."
                               (`(,(rx (seq "imported(")) . ,_) 
sweep-imported-face)
                               (`(,(rx (seq "local(")) . ,_) sweep-local-face)
                               (other (message "unknown goal color term %S" 
other) sweep-goal-face))))
-        ("syntax_error"        (put-text-property beg end 'font-lock-face 
sweep-syntax-error-face))
+        (`("syntax_error" ,message ,eb ,ee)
+         (put-text-property beg end 'font-lock-face sweep-syntax-error-face))
         ("unused_import"       (put-text-property beg end 'font-lock-face 
sweep-unused-import-face))
         ("undefined_import"    (put-text-property beg end 'font-lock-face 
sweep-undefined-import-face))
         ("dict_tag"            (put-text-property beg end 'font-lock-face 
sweep-dict-tag-face))
@@ -585,7 +586,6 @@ module name, F is a functor name and N is its arity."
         ("no_option_name"      (put-text-property beg end 'font-lock-face 
sweep-no-option-name-face))
         ("control"             (put-text-property beg end 'font-lock-face 
sweep-control-face))
         ("var"                 (put-text-property beg end 'font-lock-face 
sweep-variable-face))
-        ("body"                (put-text-property beg end 'font-lock-face 
'default))
         ("fullstop"            (put-text-property beg end 'font-lock-face 
sweep-fullstop-face))
         ("functor"             (put-text-property beg end 'font-lock-face 
sweep-functor-face))
         ("arity"               (put-text-property beg end 'font-lock-face 
sweep-arity-face))
@@ -602,10 +602,12 @@ module name, F is a functor name and N is its arity."
         ("identifier"          (put-text-property beg end 'font-lock-face 
sweep-identifier-face))
         ("file"                (put-text-property beg end 'font-lock-face 
sweep-file-face))
         ("file_no_depend"      (put-text-property beg end 'font-lock-face 
sweep-file-no-depend-face))
+        ("op_type"             (put-text-property beg end 'font-lock-face 
sweep-op-type-face))
         (`("goal_term" . ,_)   nil)
         (`("head_term" . ,_)   nil)
         ("clause"              nil)
         ("directive"           nil)
+        ("body"                nil)
         ("parentheses"         nil)
         ("term"                nil)
         ("expanded"            nil)
@@ -617,6 +619,7 @@ module name, F is a functor name and N is its arity."
         ("exported_operator"   nil)
         ("empty_list"          nil)
         ("dcg"                 nil)
+        ("qq_content"          nil)
         ("qq"                  nil)
         (other (message "Unknown color term %S" other))
         ))))
@@ -777,17 +780,24 @@ Interactively, a prefix arg means to prompt for BUFFER."
     (while (and (< 0 times) (not (eobp)))
       (setq times (1- times))
       (unless (eobp)
+        (forward-char)
         (re-search-forward (rx (seq bol graph)) nil t))
       (while (and (nth 8 (syntax-ppss)) (not (eobp)))
+        (forward-char)
         (re-search-forward (rx (seq bol graph)) nil t)))
     (not (= p (point)))))
 
 (defun sweep-end-of-top-term ()
   (unless (eobp)
-    (while (nth 8 (syntax-ppss))
-      (forward-char))
+    (while (and (nth 8 (syntax-ppss)) (not (eobp)))
+        (forward-char))
     (or (re-search-forward (rx (seq "." (or white "\n"))) nil t)
-        (goto-char (point-max)))))
+        (goto-char (point-max)))
+    (while (and (nth 8 (syntax-ppss)) (not (eobp)))
+      (while (and (nth 8 (syntax-ppss)) (not (eobp)))
+        (forward-char))
+      (or (re-search-forward (rx (seq "." (or white "\n"))) nil t)
+          (goto-char (point-max))))))
 
 (defvar sweep-mode-syntax-table
   (let ((table (make-syntax-table)))
@@ -810,6 +820,16 @@ Interactively, a prefix arg means to prompt for BUFFER."
   :doc "Keymap for `sweep-mode'."
   "C-c C-c" #'sweep-colourise-buffer)
 
+(defun sweep-syntax-propertize (start end)
+  (goto-char start)
+  (let ((case-fold-search nil))
+    (funcall
+     (syntax-propertize-rules
+      ((rx bow (group-n 1 (seq "0'" anychar)))
+       (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+            (string-to-syntax "w")))))
+     start end)))
+
 ;;;###autoload
 (define-derived-mode sweep-mode prog-mode "sweep"
   "Major mode for reading and editing Prolog code."
@@ -818,8 +838,10 @@ Interactively, a prefix arg means to prompt for BUFFER."
   (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
   (setq-local parens-require-spaces nil)
   (setq-local beginning-of-defun-function #'sweep-beginning-of-top-term)
+  (setq-local end-of-defun-function #'sweep-end-of-top-term)
+  (setq-local syntax-propertize-function #'sweep-syntax-propertize)
   (setq-local font-lock-defaults
-              '((("\\<\\([_A-Z][a-zA-Z0-9_]*\\)" 1 sweep-variable-face))
+              '(nil
                 nil
                 nil
                 nil
diff --git a/sweep.pl b/sweep.pl
index dfb152ed87..6901b5998b 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -100,42 +100,6 @@ sweep_colourise_buffer_(Path0, Contents, []) :-
     erase(Ref0),
     erase(Ref1).
 
-sweep_handle_color(comment(C), B0, L) =>
-    B is B0 + 1,
-    assertz(sweep_current_comment(B, L, C)).
-sweep_handle_color(syntax_error(D, EB-EE), _B, _L) =>
-    EL is EE-EB,
-    assertz(sweep_current_color(EB,
-                                  EL,
-                                  syntax_error(D, EB-EE))).
-sweep_handle_color(head_term(meta, Head), B0, L) =>
-    B is B0 + 1,
-    assertz(sweep_current_color(B, L, head_term(meta, Head))).
-sweep_handle_color(head_term(Kind, Head), B0, L) =>
-    B is B0+1,
-    pi_head(PI, Head),
-    assertz(sweep_current_color(B,
-                                L,
-                                head_term(Kind, PI))).
-sweep_handle_color(head(Kind, Head), B0, L) =>
-    B is B0+1,
-    pi_head(PI, Head),
-    assertz(sweep_current_color(B, L, head(Kind, PI))).
-sweep_handle_color(goal(Kind, Head), B0, L) =>
-    B is B0+1,
-    pi_head(PI, Head),
-    assertz(sweep_current_color(B, L, goal(Kind, PI))).
-sweep_handle_color(goal_term(meta, Goal), B0, L) =>
-    B is B0 + 1,
-    assertz(sweep_current_color(B, L, goal_term(meta, Goal))).
-sweep_handle_color(goal_term(Kind, Goal), B0, L) =>
-    B is B0 + 1,
-    pi_head(PI, Goal),
-    assertz(sweep_current_color(B, L, goal_term(Kind, PI))).
-sweep_handle_color(T, B0, L) =>
-    B is B0 + 1,
-    assertz(sweep_current_color(B, L, T)).
-
 sweep_documentation([Path, Functor, Arity], Docs) :-
     atom_string(P, Path),
     atom_string(F, Functor),
@@ -317,22 +281,27 @@ sweep_colourise_query([String|Offset], _) :-
     prolog_colourise_query(String, module(sweep), 
sweep_handle_query_color(Offset)).
 
 sweep_handle_query_color(Offset, Col, Beg, Len) :-
-    sweep_color_normalized(Col, Nom),
+    sweep_color_normalized(Offset, Col, Nom),
     Start is Beg + Offset,
     sweep_funcall("sweep--colourise", [Start,Len|Nom], _).
 
-sweep_color_normalized(Col, Nom) :-
+sweep_color_normalized(Offset, Col, Nom) :-
     Col =.. [Nom0|Rest],
-    sweep_color_normalized_(Nom0, Rest, Nom).
+    sweep_color_normalized_(Offset, Nom0, Rest, Nom).
 
-sweep_color_normalized_(Goal0, [Kind0,Head|_], [Goal,Kind,F,N]) :-
+sweep_color_normalized_(Offset, Goal0, [Kind0,Head|_], [Goal,Kind,F,N]) :-
     sweep_color_goal(Goal0),
     !,
     atom_string(Goal0, Goal),
     term_string(Kind0, Kind),
     pi_head(F0/N, Head),
     atom_string(F0, F).
-sweep_color_normalized_(Nom0, _, Nom) :-
+sweep_color_normalized_(Offset, syntax_error, [Message0,Start0-End0|_], 
["syntax_error", Message, Start, End]) :-
+    !,
+    Start is Start0 + Offset,
+    End   is End0   + Offset,
+    atom_string(Message0, Message).
+sweep_color_normalized_(_, Nom0, _, Nom) :-
     atom_string(Nom0, Nom).
 
 sweep_color_goal(goal).
@@ -340,7 +309,6 @@ sweep_color_goal(goal_term).
 sweep_color_goal(head).
 sweep_color_goal(head_term).
 
-
 sweep_expand_file_name([String|Dir], Exp) :-
     term_string(Spec, String, [syntax_errors(quiet)]),
     sweep_expand_file_name_(Dir, Spec, Atom),