From face064afaaf5206fc5cb289c5c6ca5dabf3ebd3 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 4 Sep 2022 22:04:16 +0300 Subject: [PATCH] ADDED: custom font-lock-fontify-region-function for sweep-mode --- sweep.el | 39 +++++++++++++++++++++++++++++++++++---- sweep.pl | 21 +++++++++++++++++++++ 2 files changed, 56 insertions(+), 4 deletions(-) diff --git a/sweep.el b/sweep.el index 46ea566..bf3aff1 100644 --- a/sweep.el +++ b/sweep.el @@ -548,8 +548,8 @@ module name, F is a functor name and N is its arity." (defun sweep--colourise (args) "ARGS is a list of the form (BEG LEN . SEM)." - (let* ((beg (car args)) - (end (+ beg (cadr args))) + (let* ((beg (max (point-min) (car args))) + (end (min (point-max) (+ beg (cadr args)))) (arg (cddr args))) (with-silent-modifications (pcase arg @@ -558,6 +558,7 @@ module name, F is a functor name and N is its arity." (pcase h (`("unreferenced" . ,_) sweep-head-unreferenced-face) (`("exported" . ,_) sweep-head-exported-face) + (`("hook" . ,_) sweep-head-hook-face) (`(,(rx (seq "local(")) . ,_) sweep-head-local-face) (other (message "unknown head color term %S" other) sweep-head-local-face)))) (`("goal" . ,g) @@ -567,17 +568,22 @@ module name, F is a functor name and N is its arity." (`("meta" . ,_) sweep-meta-face) (`("built_in" . ,_) sweep-built-in-face) (`("undefined" . ,_) sweep-undefined-face) + (`(,(rx (seq "dynamic ")) . ,_) sweep-dynamic-face) + (`(,(rx (seq "extern(")) . ,_) sweep-extern-face) (`(,(rx (seq "autoload(")) . ,_) sweep-autoload-face) (`(,(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" ,message ,eb ,ee) + (`("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)) ("dict_key" (put-text-property beg end 'font-lock-face sweep-dict-key-face)) ("dict_sep" (put-text-property beg end 'font-lock-face sweep-dict-sep-face)) + ("flag_name" (put-text-property beg end 'font-lock-face sweep-flag-name-face)) + ("no_flag_name" (put-text-property beg end 'font-lock-face sweep-flag-name-face)) + ("ext_quant" (put-text-property beg end 'font-lock-face sweep-ext-quant-face)) ("atom" (put-text-property beg end 'font-lock-face sweep-atom-face)) ("float" (put-text-property beg end 'font-lock-face sweep-float-face)) ("int" (put-text-property beg end 'font-lock-face sweep-int-face)) @@ -640,6 +646,29 @@ module name, F is a functor name and N is its arity." (sweep-close-query) sol)))) +(defun sweep-colourise-some-terms (beg0 end0 &optional _verbose) + (let* ((beg (save-mark-and-excursion + (goto-char beg0) + (sweep-beginning-of-top-term) + (point))) + (end (save-mark-and-excursion + (goto-char end0) + (sweep-end-of-top-term) + (point))) + (contents (buffer-substring-no-properties beg end))) + (with-silent-modifications + (font-lock-unfontify-region beg end)) + (sweep-open-query "user" + "sweep" + "sweep_colourise_some_terms" + (list contents + (buffer-file-name) + beg)) + (let ((sol (sweep-next-solution))) + (sweep-close-query) + (when (sweep-true-p sol) + `(jit-lock-bounds ,beg . ,end))))) + (defun sweep-colourise-query (buffer) (when (buffer-live-p buffer) (with-current-buffer buffer @@ -939,7 +968,9 @@ Interactively, a prefix arg means to prompt for BUFFER." nil nil nil - nil))) + nil + (font-lock-fontify-region-function . sweep-colourise-some-terms))) + (sweep-colourise-buffer)) ;;;; Testing: diff --git a/sweep.pl b/sweep.pl index 0a475ef..3d65efa 100644 --- a/sweep.pl +++ b/sweep.pl @@ -32,6 +32,7 @@ :- module(sweep, [ sweep_colourise_buffer/2, + sweep_colourise_some_terms/2, sweep_documentation/2, sweep_expand_file_name/2, sweep_predicate_location/2, @@ -85,6 +86,7 @@ sweep_colourise_buffer([String|Path], Colors) :- ( close(Contents), free_memory_file(H) )). + sweep_colourise_buffer_(Path0, Contents, []) :- atom_string(Path, Path0), set_stream(Contents, encoding(utf8)), @@ -100,6 +102,25 @@ sweep_colourise_buffer_(Path0, Contents, []) :- erase(Ref0), erase(Ref1). +sweep_colourise_some_terms([String,Path,Offset], Colors) :- + setup_call_cleanup(( new_memory_file(H), + insert_memory_file(H, 0, String), + open_memory_file(H, read, Contents, [encoding(utf8)]) + ), + sweep_colourise_some_terms_(Path, Offset, Contents, Colors), + ( close(Contents), + free_memory_file(H) + )). + +sweep_colourise_some_terms_(Path0, Offset, Contents, []) :- + atom_string(Path, Path0), + set_stream(Contents, encoding(utf8)), + set_stream(Contents, file_name(Path)), + seek(Contents, 0, bof, _), + prolog_colourise_stream(Contents, + Path, + sweep_handle_query_color(Offset)). + sweep_documentation([Path, Functor, Arity], Docs) :- atom_string(P, Path), atom_string(F, Functor), -- 2.39.2