From 6e7943beabf8d1092ca92f4d541034841050c208 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 16 Jan 2023 20:58:31 +0200 Subject: [PATCH] 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. --- sweep.pl | 54 +++++++++++++++++---- sweeprolog.el | 131 ++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 157 insertions(+), 28 deletions(-) diff --git a/sweep.pl b/sweep.pl index 898df66..be39806 100644 --- 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 aeabc7b..fbd62a5 100644 --- 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 -- 2.39.2