ENHANCED: improve semantic highlighting for several constructs

* sweep.pl (sweep_color_normalized_/4): fix handling of non-callable
terms, propagate type error expected type to Elisp.
(sweeprolog_goal_kind_normalized/2): rename to...
(sweep_goal_kind_normalized/2): normalize all goal and head classes.
* sweeprolog.el (sweeprolog-analyze-fragment-to-faces): adapt to new
info from sweep_goal_kind_normalized/2, and highlight some missing
token kinds.

diff --git a/sweep.pl b/sweep.pl
index 898df6643bbe45d1fc5b5d25a8c21e91d8a96dda..be39806a4cf879c00af4de858160351c19944709 100644 (file)
--- a/sweep.pl
+++ b/sweep.pl
@@ -470,14 +470,11 @@ sweep_color_normalized_(_, Goal0, [Kind0,Head|_], [Goal,Kind,F,N]) :-
     sweep_color_goal(Goal0),
     !,
     atom_string(Goal0, Goal),
-    sweeprolog_goal_kind_normalized(Kind0, Kind),
-    (   (   var(Head)
-        ->  true
-        ;   Head == []
-        )
-    ->  F = Head, N = 0
-    ;   pi_head(F0/N, Head),
+    sweep_goal_kind_normalized(Kind0, Kind),
+    (   callable(Head)
+    ->  pi_head(F0/N, Head),
         atom_string(F0, F)
+    ;   term_string(Head, F), N = 0
     ).
 sweep_color_normalized_(Offset, syntax_error, [Message0,Start0-End0|_], ["syntax_error", Message, Start, End]) :-
     !,
@@ -505,20 +502,59 @@ sweep_color_normalized_(_, file, [File0|_], ["file"|File]) :-
 sweep_color_normalized_(_, file_no_depend, [File0|_], ["file_no_depend"|File]) :-
     !,
     atom_string(File0, File).
+sweep_color_normalized_(_, type_error, [Kind0|_], ["type_error"|Kind]) :-
+    !,
+    Kind0 =.. [Kind1|_],
+    atom_string(Kind1, Kind).
 sweep_color_normalized_(_, Nom0, _, Nom) :-
     atom_string(Nom0, Nom).
 
-sweeprolog_goal_kind_normalized(autoload(Path0), ["autoload"|Path]) :-
+sweep_goal_kind_normalized(autoload(Path0), ["autoload"|Path]) :-
+    !,
+    absolute_file_name(Path0, Path1, [extensions([pl])]),
+    atom_string(Path1, Path).
+sweep_goal_kind_normalized(imported(Path0), ["imported"|Path]) :-
     !,
     absolute_file_name(Path0, Path1, [extensions([pl])]),
     atom_string(Path1, Path).
-sweeprolog_goal_kind_normalized(Kind0, Kind) :-
+sweep_goal_kind_normalized(global(Kind0, _), ["global"|Kind]) :-
+    !,
+    atom_string(Kind0, Kind).
+sweep_goal_kind_normalized(thread_local(_), "thread_local") :-
+    !.
+sweep_goal_kind_normalized(dynamic(_), "dynamic") :-
+    !.
+sweep_goal_kind_normalized(multifile(_), "multifile") :-
+    !.
+sweep_goal_kind_normalized(foreign(_), "foreign") :-
+    !.
+sweep_goal_kind_normalized(local(_), "local") :-
+    !.
+sweep_goal_kind_normalized(constraint(_), "constraint") :-
+    !.
+sweep_goal_kind_normalized(public(_), "public") :-
+    !.
+sweep_goal_kind_normalized(extern(Module0), ["extern",Module]) :-
+    !,
+    (   atom(Module0)
+    ->  atom_string(Module0, Module)
+    ;   Module = Module0
+    ).
+sweep_goal_kind_normalized(extern(Module0,Kind0), ["extern",Module,Kind]) :-
+    !,
+    (   atom(Module0)
+    ->  atom_string(Module0, Module)
+    ;   Module = Module0
+    ),
+    atom_string(Kind0, Kind).
+sweep_goal_kind_normalized(Kind0, Kind) :-
     term_string(Kind0, Kind).
 
 sweep_color_goal(goal).
 sweep_color_goal(goal_term).
 sweep_color_goal(head).
 sweep_color_goal(head_term).
+sweep_color_goal(predicate_indicator).
 
 sweep_expand_file_name([String|Dir], Exp) :-
     term_string(Spec, String, [syntax_errors(quiet)]),

diff --git a/sweeprolog.el b/sweeprolog.el
index aeabc7b911a79307795d4b224058bd4dc2614041..fbd62a53c3ac6bd1a608c35bdb56e4cfa236f112 100644 (file)
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -1467,6 +1467,13 @@ resulting list even when found in the current clause."
   (:foreground "#016300" :weight bold)
   "Public definitions.")
 
+(sweeprolog-defface
+  head-constraint
+  (:inherit font-lock-function-name-face)
+  (:foreground "navyblue")
+  (:foreground "palegreen")
+  "Constraint definitions.")
+
 (sweeprolog-defface
   meta-spec
   (:inherit font-lock-preprocessor-face)
@@ -1488,6 +1495,13 @@ resulting list even when found in the current clause."
   (:foreground "darkcyan")
   "Local predicate calls.")
 
+(sweeprolog-defface
+  expanded
+  (:inherit font-lock-function-name-face)
+  (:foreground "blue" :underline t)
+  (:foreground "cyan" :underline t)
+  "Expanded predicate calls.")
+
 (sweeprolog-defface
   autoload
   (:inherit font-lock-function-name-face)
@@ -1537,6 +1551,20 @@ resulting list even when found in the current clause."
   (:foreground "magenta" :underline t)
   "Thread local predicate calls.")
 
+(sweeprolog-defface
+  not-callable
+  (:inherit font-lock-warning-face)
+  (:background "orange")
+  (:background "orange")
+  "Terms that are not callable.")
+
+(sweeprolog-defface
+  constraint
+  (:inherit font-lock-function-name-face)
+  (:foreground "navyblue")
+  (:foreground "palegreen")
+  "Constraint calls.")
+
 (sweeprolog-defface
   global
   (:inherit font-lock-keyword-face)
@@ -1670,6 +1698,27 @@ resulting list even when found in the current clause."
   (:weight bold)
   "Dict separators.")
 
+(sweeprolog-defface
+  dict-return-op
+  (:inherit font-lock-preprocessor-face)
+  (:foreground "blue")
+  (:foreground "cyan")
+  "Dict return operators.")
+
+(sweeprolog-defface
+  dict-function
+  (:inherit font-lock-function-name-face)
+  (:foreground "navyblue")
+  (:foreground "darkcyan")
+  "Dict functions.")
+
+(sweeprolog-defface
+  func-dot
+  (:inherit font-lock-preprocessor-face)
+  (:weight bold)
+  (:weight bold)
+  "Dict function dots.")
+
 (sweeprolog-defface
   file
   (:inherit button)
@@ -1754,6 +1803,13 @@ resulting list even when found in the current clause."
   (:inherit font-lock-keyword-face)
   "Existential quantifiers.")
 
+(sweeprolog-defface
+  keyword
+  (:inherit font-lock-keyword-face)
+  (:foreground "blue")
+  (:foreground "cyan")
+  "Control constructs.")
+
 (sweeprolog-defface
   control
   (:inherit font-lock-keyword-face)
@@ -1783,10 +1839,24 @@ resulting list even when found in the current clause."
   "Floats.")
 
 (sweeprolog-defface
-  codes
+  rational
   (:inherit font-lock-constant-face)
+  (:foreground "steelblue")
+  (:foreground "steelblue")
+  "Rationals.")
+
+(sweeprolog-defface
+  chars
   (:inherit font-lock-constant-face)
+  (:foreground "navyblue")
+  (:foreground "palegreen")
+  "Chars.")
+
+(sweeprolog-defface
+  codes
   (:inherit font-lock-constant-face)
+  (:foreground "navyblue")
+  (:foreground "palegreen")
   "Codes.")
 
 (sweeprolog-defface
@@ -1933,20 +2003,24 @@ resulting list even when found in the current clause."
      (list (list beg end (sweeprolog-head-hook-face))))
     (`("head" "built_in" . ,_)
      (list (list beg end (sweeprolog-head-built-in-face))))
-    (`("goal" ("autoload" . ,_) . ,_)
-     (list (list beg end (sweeprolog-autoload-face))))
-    (`("head" ,(rx "imported(") . ,_)
+    (`("head" ("imported" . ,_) . ,_)
      (list (list beg end (sweeprolog-head-imported-face))))
-    (`("head" ,(rx "extern(") . ,_)
+    (`("head" ("extern" . ,_) . ,_)
      (list (list beg end (sweeprolog-head-extern-face))))
-    (`("head" ,(rx "public ") . ,_)
+    (`("head" "public" . ,_)
      (list (list beg end (sweeprolog-head-public-face))))
-    (`("head" ,(rx "dynamic ") . ,_)
+    (`("head" "dynamic" . ,_)
      (list (list beg end (sweeprolog-head-dynamic-face))))
-    (`("head" ,(rx "multifile ") . ,_)
+    (`("head" "multifile" . ,_)
      (list (list beg end (sweeprolog-head-multifile-face))))
-    (`("head" ,(rx "local(") . ,_)
+    (`("head" "local" . ,_)
      (list (list beg end (sweeprolog-head-local-face))))
+    (`("head" "constraint" . ,_)
+     (list (list beg end (sweeprolog-head-constraint-face))))
+    (`("goal" ("autoload" . ,_) . ,_)
+     (list (list beg end (sweeprolog-autoload-face))))
+    (`("goal" "expanded" . ,_)
+     (list (list beg end (sweeprolog-expanded-face))))
     (`("goal" "recursion" . ,_)
      (list (list beg end (sweeprolog-recursion-face))))
     (`("goal" "meta"      . ,_)
@@ -1957,23 +2031,27 @@ resulting list even when found in the current clause."
      (list (list beg end (sweeprolog-undefined-face))))
     (`("goal" "global" . ,_)
      (list (list beg end (sweeprolog-global-face))))
-    (`("goal" ,(rx "dynamic ") . ,_)
+    (`("goal" "not_callable" . ,_)
+     (list (list beg end (sweeprolog-not-callable-face))))
+    (`("goal" "dynamic" . ,_)
      (list (list beg end (sweeprolog-dynamic-face))))
-    (`("goal" ,(rx "multifile ") . ,_)
+    (`("goal" "multifile" . ,_)
      (list (list beg end (sweeprolog-multifile-face))))
-    (`("goal" ,(rx "thread_local ") . ,_)
+    (`("goal" "thread_local" . ,_)
      (list (list beg end (sweeprolog-thread-local-face))))
-    (`("goal" ,(rx "extern(") . ,_)
+    (`("goal" ("extern" . ,_) . ,_)
      (list (list beg end (sweeprolog-extern-face))))
-    (`("goal" ,(rx "imported(") . ,_)
+    (`("goal" ("imported" . ,_) . ,_)
      (list (list beg end (sweeprolog-imported-face))))
-    (`("goal" ,(rx "global(") . ,_)
+    (`("goal" ("global" . ,_) . ,_)
      (list (list beg end (sweeprolog-global-face))))
-    (`("goal" ,(rx "local(") . ,_)
+    (`("goal" "local" . ,_)
      (list (list beg end (sweeprolog-local-face))))
+    (`("goal" "constraint" . ,_)
+     (list (list beg end (sweeprolog-constraint-face))))
     ("instantiation_error"
      (list (list beg end (sweeprolog-instantiation-error-face))))
-    ("type_error"
+    (`("type_error" . ,_)
      (list (list beg end (sweeprolog-type-error-face))))
     (`("syntax_error" ,_ ,eb ,ee)
      (let ((eb (min eb beg))
@@ -2002,6 +2080,8 @@ resulting list even when found in the current clause."
      (list (list beg end (sweeprolog-undefined-import-face))))
     ("error"
      (list (list beg end (sweeprolog-error-face))))
+    ("keyword"
+     (list (list beg end (sweeprolog-keyword-face))))
     ("html_attribute"
      (list (list beg end (sweeprolog-html-attribute-face))))
     ("html"
@@ -2012,6 +2092,12 @@ resulting list even when found in the current clause."
      (list (list beg end (sweeprolog-dict-key-face))))
     ("dict_sep"
      (list (list beg end (sweeprolog-dict-sep-face))))
+    ("dict_function"
+     (list (list beg end (sweeprolog-dict-function-face))))
+    ("dict_return_op"
+     (list (list beg end (sweeprolog-dict-return-op-face))))
+    ("func_dot"
+     (list (list beg end (sweeprolog-func-dot-face))))
     ("meta"
      (list (list beg end (sweeprolog-meta-spec-face))))
     ("flag_name"
@@ -2024,6 +2110,8 @@ resulting list even when found in the current clause."
      (list (list beg end (sweeprolog-atom-face))))
     ("float"
      (list (list beg end (sweeprolog-float-face))))
+    ("rational"
+     (list (list beg end (sweeprolog-rational-face))))
     ("int"
      (list (list beg end (sweeprolog-int-face))))
     ("singleton"
@@ -2057,6 +2145,10 @@ resulting list even when found in the current clause."
      (list (list beg end (sweeprolog-arity-face))))
     ("predicate_indicator"
      (list (list beg end (sweeprolog-predicate-indicator-face))))
+    ("chars"
+     (list (list beg end (sweeprolog-chars-face))))
+    ("codes"
+     (list (list beg end (sweeprolog-codes-face))))
     ("string"
      (list (list beg end (sweeprolog-string-face))))
     (`("module" . ,_)
@@ -2199,8 +2291,9 @@ resulting list even when found in the current clause."
                                   file)))))
                 ("instantiation_error"
                  (cons :warning "Instantiation error"))
-                ("type_error"
-                 (cons :warning "Type error"))
+                (`("type_error" . ,error-type)
+                 (cons :warning (format "Type error (expected %s)"
+                                        error-type)))
                 (`("syntax_error" ,message . ,_)
                  (and (or (and sweeprolog--analyze-point
                                (<= (save-excursion