From 0078ef8ff06d37b759d5f37015fade6c03d852c4 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 4 Sep 2022 11:04:15 +0300 Subject: [PATCH] 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 ec94dd4..48309a2 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 dfb152e..6901b59 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), -- 2.39.2