[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog 239e205add 059/166: ADDED: sweep-mode, a major
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/sweeprolog 239e205add 059/166: ADDED: sweep-mode, a major mode for editing Prolog code |
Date: |
Fri, 30 Sep 2022 04:59:26 -0400 (EDT) |
branch: elpa/sweeprolog
commit 239e205add59ea1339e86473952b6dbc806b58d9
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
ADDED: sweep-mode, a major mode for editing Prolog code
---
sweep.c | 3 +-
sweep.el | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
sweep.pl | 24 ++++--------
3 files changed, 127 insertions(+), 30 deletions(-)
diff --git a/sweep.c b/sweep.c
index df6611c629..e55496e15b 100644
--- a/sweep.c
+++ b/sweep.c
@@ -72,8 +72,7 @@ estring_to_pstring(emacs_env *eenv, emacs_value estring,
term_t t) {
int i = 0;
if ((buf = estring_to_cstring(eenv, estring, &len)) == NULL) return -1;
-
- i = PL_put_string_nchars(t, len - 1, buf);
+ i = PL_put_chars(t, PL_STRING|REP_UTF8, len - 1, buf);
free(buf);
return i;
}
diff --git a/sweep.el b/sweep.el
index 42c00a0f75..ec94dd4f9f 100644
--- a/sweep.el
+++ b/sweep.el
@@ -553,6 +553,13 @@ module name, F is a functor name and N is its arity."
(arg (cddr args)))
(with-silent-modifications
(pcase arg
+ (`("head" . ,h)
+ (put-text-property beg end 'font-lock-face
+ (pcase h
+ (`("unreferenced" . ,_)
sweep-head-unreferenced-face)
+ (`("exported" . ,_) sweep-head-exported-face)
+ (`(,(rx (seq "local(")) . ,_)
sweep-head-local-face)
+ (other (message "unknown head color term %S"
other) sweep-head-local-face))))
(`("goal" . ,g)
(put-text-property beg end 'font-lock-face
(pcase g
@@ -560,7 +567,11 @@ 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)
- (_ sweep-goal-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" (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))
@@ -581,9 +592,51 @@ module name, F is a functor name and N is its arity."
("predicate_indicator" (put-text-property beg end 'font-lock-face
sweep-predicate-indicator-face))
("string" (put-text-property beg end 'font-lock-face
sweep-string-face))
("module" (put-text-property beg end 'font-lock-face
sweep-module-face))
- ;; (other (message "Unknown color term %S" other))
+ ("neck" (put-text-property beg end 'font-lock-face
sweep-neck-face))
+ ("comment" (put-text-property beg end 'font-lock-face
sweep-comment-face))
+ ("hook" (put-text-property beg end 'font-lock-face
sweep-hook-face))
+ ("qq_type" (put-text-property beg end 'font-lock-face
sweep-qq-type-face))
+ ("qq_sep" (put-text-property beg end 'font-lock-face
sweep-qq-sep-face))
+ ("qq_open" (put-text-property beg end 'font-lock-face
sweep-qq-open-face))
+ ("qq_close" (put-text-property beg end 'font-lock-face
sweep-qq-close-face))
+ ("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))
+ (`("goal_term" . ,_) nil)
+ (`("head_term" . ,_) nil)
+ ("clause" nil)
+ ("directive" nil)
+ ("parentheses" nil)
+ ("term" nil)
+ ("expanded" nil)
+ ("list" nil)
+ ("grammar_rule" nil)
+ ("dict" nil)
+ ("brace_term" nil)
+ ("rule_condition" nil)
+ ("exported_operator" nil)
+ ("empty_list" nil)
+ ("dcg" nil)
+ ("qq" nil)
+ (other (message "Unknown color term %S" other))
))))
+(defun sweep-colourise-buffer (&optional buffer)
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (let* ((beg (point-min))
+ (end (point-max))
+ (contents (buffer-substring-no-properties beg end)))
+ (with-silent-modifications
+ (font-lock-unfontify-region beg end))
+ (sweep-open-query "user"
+ "sweep"
+ "sweep_colourise_buffer"
+ (cons contents (buffer-file-name)))
+ (let ((sol (sweep-next-solution)))
+ (sweep-close-query)
+ sol))))
+
(defun sweep-colourise-query (buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
@@ -702,16 +755,32 @@ Interactively, a prefix arg means to prompt for BUFFER."
(cons (rx (seq bol (one-or-more lower) "("))
#'sweep-file-name-handler))
-(defun sweep-beginning-of-top-term ()
- (unless (bobp)
- (when-let ((safe-start (nth 8 (syntax-ppss))))
- (goto-char safe-start))
- (re-search-backward (rx (seq bol graph)) nil t)
- (let ((safe-start (nth 8 (syntax-ppss))))
- (while (and safe-start (not (bobp)))
- (goto-char safe-start)
- (re-search-backward (rx (seq bol graph)) nil t)
- (setq safe-start (nth 8 (syntax-ppss)))))))
+(defun sweep-beginning-of-top-term (&optional arg)
+ (let ((times (or arg 1)))
+ (if (< 0 times)
+ (let ((p (point)))
+ (while (and (< 0 times) (not (bobp)))
+ (setq times (1- times))
+ (when-let ((safe-start (nth 8 (syntax-ppss))))
+ (goto-char safe-start))
+ (re-search-backward (rx (seq bol graph)) nil t)
+ (let ((safe-start (nth 8 (syntax-ppss))))
+ (while (and safe-start (not (bobp)))
+ (goto-char safe-start)
+ (re-search-backward (rx (seq bol graph)) nil t)
+ (setq safe-start (nth 8 (syntax-ppss))))))
+ (not (= p (point))))
+ (sweep-beginning-of-next-top-term (- times)))))
+
+(defun sweep-beginning-of-next-top-term (times)
+ (let ((p (point)))
+ (while (and (< 0 times) (not (eobp)))
+ (setq times (1- times))
+ (unless (eobp)
+ (re-search-forward (rx (seq bol graph)) nil t))
+ (while (and (nth 8 (syntax-ppss)) (not (eobp)))
+ (re-search-forward (rx (seq bol graph)) nil t)))
+ (not (= p (point)))))
(defun sweep-end-of-top-term ()
(unless (eobp)
@@ -719,6 +788,43 @@ Interactively, a prefix arg means to prompt for BUFFER."
(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)))
+ (modify-syntax-entry ?_ "_" table)
+ (modify-syntax-entry ?+ "." table)
+ (modify-syntax-entry ?- "." table)
+ (modify-syntax-entry ?= "." table)
+ (modify-syntax-entry ?< "." table)
+ (modify-syntax-entry ?> "." table)
+ (modify-syntax-entry ?| "." table)
+ (modify-syntax-entry ?\' "\"" table)
+ (modify-syntax-entry ?` "\"" table)
+ (modify-syntax-entry ?% "<" table)
+ (modify-syntax-entry ?\n ">" table)
+ (modify-syntax-entry ?* ". 23b" table)
+ (modify-syntax-entry ?/ ". 14" table)
+ table))
+
+(defvar-keymap sweep-mode-map
+ :doc "Keymap for `sweep-mode'."
+ "C-c C-c" #'sweep-colourise-buffer)
+
+;;;###autoload
+(define-derived-mode sweep-mode prog-mode "sweep"
+ "Major mode for reading and editing Prolog code."
+ :group 'sweep
+ (setq-local comment-start "%")
+ (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
+ (setq-local parens-require-spaces nil)
+ (setq-local beginning-of-defun-function #'sweep-beginning-of-top-term)
+ (setq-local font-lock-defaults
+ '((("\\<\\([_A-Z][a-zA-Z0-9_]*\\)" 1 sweep-variable-face))
+ nil
+ nil
+ nil
+ nil)))
+
;;;; Testing:
;; (add-to-list 'load-path (file-name-directory (buffer-file-name)))
diff --git a/sweep.pl b/sweep.pl
index 9f9987b797..dfb152ed87 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -31,7 +31,7 @@
*/
:- module(sweep,
- [ sweep_colors/2,
+ [ sweep_colourise_buffer/2,
sweep_documentation/2,
sweep_expand_file_name/2,
sweep_predicate_location/2,
@@ -76,37 +76,29 @@ prolog:xref_open_source(Source, Stream) :-
prolog:xref_close_source(Source, Stream) :-
sweep_open(Source, Stream).
-sweep_colors([Path, String], Colors) :-
+sweep_colourise_buffer([String|Path], Colors) :-
setup_call_cleanup(( new_memory_file(H),
insert_memory_file(H, 0, String),
- open_memory_file(H, read, Contents)
+ open_memory_file(H, read, Contents, [encoding(utf8)])
),
- sweep_colors(Path, Contents, Colors),
+ sweep_colourise_buffer_(Path, Contents, Colors),
( close(Contents),
free_memory_file(H)
)).
-sweep_colors(Path, Contents, Colors) :-
+sweep_colourise_buffer_(Path0, Contents, []) :-
+ atom_string(Path, Path0),
set_stream(Contents, encoding(utf8)),
set_stream(Contents, file_name(Path)),
get_time(Time),
asserta(sweep_open(Path, Contents), Ref0),
asserta(sweep_source_time(Path, Time), Ref1),
xref_source(Path, []),
- retractall(sweep_current_color(_, _, _)),
- retractall(sweep_current_comment(_, _, _)),
seek(Contents, 0, bof, _),
prolog_colourise_stream(Contents,
Path,
- sweep_handle_color),
+ sweep_handle_query_color(1)),
erase(Ref0),
- erase(Ref1),
- findall([B,L,T],
- sweep_current_color(B, L, T),
- Colors,
- Comments),
- findall([B,L,T],
- sweep_current_comment(B, L, T),
- Comments).
+ erase(Ref1).
sweep_handle_color(comment(C), B0, L) =>
B is B0 + 1,
- [nongnu] elpa/sweeprolog 59b9dde951 028/166: DOC: Document sweep-pack-install, (continued)
- [nongnu] elpa/sweeprolog 59b9dde951 028/166: DOC: Document sweep-pack-install, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog b67e5b5e3d 029/166: DOC: Expand the manual section about Querying Prolog, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 5455c53eaf 031/166: ENHANCED: Add optional "reverse" argument flag to sweep-open-query, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog ff13d97396 034/166: DOC: Add CUSTOM_ID properties to README.org headings where needed, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 5fa0e16ee3 037/166: DOC: Document sweep_funcall/2, 3 in the manual, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 66ac977deb 045/166: Make use of the new SWI-Prolog embedded GMP handling..., ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 8f1275f113 044/166: Remove the swipl-devel git submodule, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 5dcdec144d 052/166: PORT: use swipl --dump-runtime-variables to locate SWI-Prolog.h, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog b24f66da61 051/166: Add licensing information, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 43e5cdaf91 054/166: ADDED: global keymap sweep-prefix-map, not bound by default, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 239e205add 059/166: ADDED: sweep-mode, a major mode for editing Prolog code,
ELPA Syncer <=
- [nongnu] elpa/sweeprolog d226bbb70c 063/166: ENHANCED: set per buffer module name in sweep-mode, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog d974b0fe0a 071/166: ADDED: prepare xref backend, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 27c441ab49 068/166: PORT: don't rely on defvar-keymap available only since Emacs 29, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 0b054bac88 072/166: ENHANCED: better detection of the identifier at point, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog c59ead20f7 075/166: ENHANCED: redirect Prolog messages to Emacs message function, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 031c07ac93 076/166: DOC: document the Prolog messages buffer, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 8ac0e7afb9 065/166: ENHANCED: also complete predicate names from xref, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 85ca3a5dc2 067/166: FIXED: bind SourceId in xref based completions, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog 21a4475306 112/166: Makefile: Allow specifying the path to emacs, ELPA Syncer, 2022/09/30
- [nongnu] elpa/sweeprolog ec01154a41 102/166: PORT: sweep.el: require Emacs version 28 for RTLD_GLOBAL, ELPA Syncer, 2022/09/30