From f72ebe6d62bec4dcd35abd1398a7d0f17a61766f Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Wed, 21 Sep 2022 21:58:39 +0300
Subject: [PATCH] ENHANCHED: automatic syntax aware autoindentation in
 sweep-mode

---
 sweep-tests.el | 170 +++++++++++++++++++++++++
 sweep.el       | 338 ++++++++++++++++++++++++++++++++++---------------
 2 files changed, 403 insertions(+), 105 deletions(-)

diff --git a/sweep-tests.el b/sweep-tests.el
index 84a0610..347f485 100644
--- a/sweep-tests.el
+++ b/sweep-tests.el
@@ -1,3 +1,5 @@
+;;; sweep-tests.el --- ERT suite for sweep  -*- lexical-binding:t -*-
+
 (ert-deftest lists:member/2 ()
   "Tests calling the Prolog predicate permutation/2 from Elisp."
   (should (equal (sweep-open-query "user" "lists" "member" (list 1 2 3) t) t))
@@ -24,3 +26,171 @@
   (should (equal (sweep-next-solution) (list '! 1 nil (list "foo" "bar") 3.14)))
   (should (equal (sweep-next-solution) nil))
   (should (equal (sweep-cut-query) t)))
+
+
+(defun sweep-test-indentation (given expected)
+  (with-temp-buffer
+    (sweep-mode)
+    (insert given)
+    (indent-region-line-by-line (point-min) (point-max))
+    (should (string= (buffer-substring-no-properties (point-min) (point-max))
+                     expected))))
+
+(ert-deftest indentation ()
+  "Tests indentation rules."
+  (sweep-test-indentation
+   "
+colourise_declaration(Module:PI, _, TB,
+                      term_position(_,_,QF,QT,[PM,PG])) :-
+    atom(Module), nonvar(PI), PI = Name/Arity,
+    !,                                  % partial predicate indicators
+    colourise_module(Module, TB, PM),
+    colour_item(functor, TB, QF-QT),
+    (   (var(Name) ; atom(Name)),
+        (var(Arity) ; integer(Arity),
+                      Arity >= 0)
+    ->  colourise_term_arg(PI, TB, PG)
+    ;   colour_item(type_error(predicate_indicator), TB, PG)
+    ).
+"
+   "
+colourise_declaration(Module:PI, _, TB,
+                      term_position(_,_,QF,QT,[PM,PG])) :-
+    atom(Module), nonvar(PI), PI = Name/Arity,
+    !,                                  % partial predicate indicators
+    colourise_module(Module, TB, PM),
+    colour_item(functor, TB, QF-QT),
+    (   (var(Name) ; atom(Name)),
+        (var(Arity) ; integer(Arity),
+                      Arity >= 0)
+    ->  colourise_term_arg(PI, TB, PG)
+    ;   colour_item(type_error(predicate_indicator), TB, PG)
+    ).
+")
+  (sweep-test-indentation
+   "
+A is 1 * 2 + 3 *
+4.
+"
+   "
+A is 1 * 2 + 3 *
+             4.
+")
+  (sweep-test-indentation
+   "
+A is 1 * 2 ^ 3 *
+4.
+"
+   "
+A is 1 * 2 ^ 3 *
+     4.
+")
+  (sweep-test-indentation
+   "
+(   if
+    ->  (   iff1, iff2, iff3,
+iff4
+->  thenn
+;   elsee
+)
+        ;   else
+            )
+"
+   "
+(   if
+->  (   iff1, iff2, iff3,
+        iff4
+    ->  thenn
+    ;   elsee
+    )
+;   else
+)
+")
+  (sweep-test-indentation
+   "
+(   if
+    ->  (   iff
+->  thenn
+;   elsee
+)
+        ;   else
+            )
+"
+   "
+(   if
+->  (   iff
+    ->  thenn
+    ;   elsee
+    )
+;   else
+)
+")
+  (sweep-test-indentation
+   "
+(   if
+    ;   then
+        ->  else
+            )
+"
+   "
+(   if
+;   then
+->  else
+)
+")
+  (sweep-test-indentation
+   "
+asserta(   foo(bar, baz) :-
+true).
+"
+   "
+asserta(   foo(bar, baz) :-
+               true).
+")
+  (sweep-test-indentation
+   "
+foo(bar, baz) :-
+true.
+"
+   "
+foo(bar, baz) :-
+    true.
+")
+
+  (sweep-test-indentation
+   "
+:- multifile
+foo/2.
+"
+   "
+:- multifile
+       foo/2.
+")
+
+  (sweep-test-indentation
+   "
+    %%%%
+    %%%%
+"
+   "
+    %%%%
+    %%%%
+")
+
+  (sweep-test-indentation
+   "
+(
+foo"
+   "
+(
+    foo")
+  (sweep-test-indentation
+   "
+functor(
+foo"
+   "
+functor(
+    foo")
+  )
+
+;;; sweep-tests.el ends here
diff --git a/sweep.el b/sweep.el
index 8ed4951..60f825c 100644
--- a/sweep.el
+++ b/sweep.el
@@ -6,7 +6,7 @@
 ;; Maintainer: Eshel Yaron <me(at)eshelyaron(dot)com>
 ;; Keywords: prolog languages extensions
 ;; URL: https://git.sr.ht/~eshel/sweep
-;; Package-Version: 0.2.1
+;; Package-Version: 0.3.0
 ;; Package-Requires: ((emacs "28"))
 
 ;; This file is NOT part of GNU Emacs.
@@ -1140,119 +1140,244 @@ Interactively, a prefix arg means to prompt for BUFFER."
     map)
   "Keymap for `sweep-mode'.")
 
-(defun sweep-indent-line ()
-  (interactive)
-  (when-let ((pos (- (point-max) (point)))
-             (indent (sweep-indent-line-indentation (point))))
-    (back-to-indentation)
-    (beginning-of-line)
-    (combine-after-change-calls
-      (delete-horizontal-space)
-      (insert (make-string indent ? )))
-    (when (> (- (point-max) pos) (point))
-      (goto-char (- (point-max) pos)))
-    t))
-
-(defun sweep-indent-line-indentation (point)
-  (save-match-data
+(defun sweep-token-boundaries (&optional pos)
+  (let ((point (or pos (point))))
     (save-excursion
-      (beginning-of-line)
-      (re-search-backward (rx bol (zero-or-more (not "\n")) graph (zero-or-more (not "\n"))) nil t)
-      (cond
-       ((sweep-indent-line-ends-with-comment-or-string-p) 0)
-       ((sweep-indent-line-ends-with-fullstop-p)          0)
-       ((sweep-indent-line-ends-with-if))
-       ((sweep-indent-line-ends-with-then point))
-       ((sweep-indent-line-ends-with-else point))
-       ((sweep-indent-line-ends-with-arg point))
-       ((sweep-indent-line-ends-with-neck-p)              4)
-       ((sweep-indent-line-ends-with-prefix-operator))
-       (t (sweep-indent-line-fallback))))))
-
-(defun sweep-indent-line-fallback ()
-  (save-excursion
-    (when-let ((open (nth 1 (syntax-ppss))))
-      (goto-char open))
-    (back-to-indentation)
-    (current-column)))
+      (goto-char point)
+      (unless (eobp)
+       (let ((beg (point))
+             (syn (char-syntax (char-after))))
+         (cond
+          ((or (= syn ?w) (= syn ?_))
+           (skip-syntax-forward "w_")
+           (if (= (char-syntax (char-after)) ?\()
+               (progn
+                 (forward-char)
+                 (list 'functor beg (point)))
+             (list 'symbol beg (point))))
+          ((= syn ?\")
+           (forward-char)
+           (while (and (not (eobp)) (nth 3 (syntax-ppss)))
+             (forward-char))
+           (list 'string beg (point)))
+          ((= syn ?.)
+           (skip-syntax-forward ".")
+           (list 'operator beg (point)))
+          ((= syn ?\()
+           (list 'open beg (point)))
+          ((= syn ?\))
+           (list 'close beg (point)))
+          ((= syn ?>) nil)
+          (t (list 'else beg (point)))))))))
+
+(defun sweep-last-token-boundaries (&optional pos)
+  (let ((point (or pos (point)))
+        (go t))
+    (save-excursion
+      (goto-char point)
+      (while (and (not (bobp)) go)
+        (skip-chars-backward " \t\n")
+        (unless (bobp)
+          (forward-char -1)
+          (if (nth 4 (syntax-ppss))
+              (goto-char (nth 8 (syntax-ppss)))
+            (setq go nil))))
+      (unless (bobp)
+        (let ((end (1+ (point)))
+              (syn (char-syntax (char-after))))
+          (cond
+           ((or (= syn ?w) (= syn ?_))
+            (skip-syntax-backward "w_")
+            (list 'symbol (point) end))
+           ((= syn ?\")
+            (list 'string (nth 8 (syntax-ppss)) end))
+           ((and (= syn ?\()
+                 (or (= (char-syntax (char-before)) ?w)
+                     (= (char-syntax (char-before)) ?_)))
+            (skip-syntax-backward "w_")
+            (list 'functor (point) end))
+           ((= syn ?.)
+            (skip-syntax-backward ".")
+            (list 'operator (point) end))
+           ((= syn ?\()
+            (list 'open (1- end) end))
+           ((= syn ?\))
+            (list 'close (1- end) end))
+           (t (list 'else (1- end) end))))))))
+
+(defun sweep-backward-term (pre)
+  (pcase (sweep-last-token-boundaries)
+    ('nil nil)
+    (`(open,_ ,_) nil)
+    (`(functor,_ ,_) nil)
+    (`(operator ,obeg ,oend)
+     (unless (and (string= "." (buffer-substring-no-properties obeg oend))
+                  (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+      (if-let ((opre (sweep-op-infix-precedence
+                      (buffer-substring-no-properties obeg oend))))
+          (when (<= opre pre)
+            (goto-char obeg)
+            (sweep-backward-term pre))
+        (if-let ((ppre (sweep-op-prefix-precedence
+                        (buffer-substring-no-properties obeg oend))))
+            (when (<= ppre pre)
+              (goto-char obeg)
+              (sweep-backward-term pre))
+          (goto-char obeg)
+          (sweep-backward-term pre)))))
+    (`(symbol ,obeg ,oend)
+     (if-let ((opre (sweep-op-infix-precedence
+                     (buffer-substring-no-properties obeg oend))))
+         (when (<= opre pre)
+           (goto-char obeg)
+           (sweep-backward-term pre))
+       (if-let ((ppre (sweep-op-prefix-precedence
+                       (buffer-substring-no-properties obeg oend))))
+           (when (<= ppre pre)
+             (goto-char obeg)
+             (sweep-backward-term pre))
+         (goto-char obeg)
+         (sweep-backward-term pre))))
+    (`(close ,lbeg ,_lend)
+     (goto-char (nth 1 (syntax-ppss lbeg)))
+     (when (or (= (char-syntax (char-before)) ?w)
+               (= (char-syntax (char-before)) ?_))
+       (skip-syntax-backward "w_"))
+     (sweep-backward-term pre))
+    (`(,_ ,lbeg ,_)
+     (goto-char lbeg)
+     (sweep-backward-term pre))))
+
+(defun sweep-op-suffix-precedence (token)
+  (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+  (let ((res nil) (go t))
+    (while go
+      (if-let ((sol (sweep-next-solution))
+               (det (car sol))
+               (fix (cadr sol))
+               (pre (cddr sol)))
+          (if (member fix '("xf" "yf"))
+              (setq res pre go nil)
+            (when (eq '! det)
+              (setq go nil)))
+        (setq go nil)))
+    (sweep-close-query)
+    res))
+
+(defun sweep-op-prefix-precedence (token)
+  (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+  (let ((res nil) (go t))
+    (while go
+      (if-let ((sol (sweep-next-solution))
+               (det (car sol))
+               (fix (cadr sol))
+               (pre (cddr sol)))
+          (if (member fix '("fx" "fy"))
+              (setq res pre go nil)
+            (when (eq '! det)
+              (setq go nil)))
+        (setq go nil)))
+    (sweep-close-query)
+    res))
+
+(defun sweep-op-infix-precedence (token)
+  (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+  (let ((res nil) (go t))
+    (while go
+      (if-let ((sol (sweep-next-solution))
+               (det (car sol))
+               (fix (cadr sol))
+               (pre (cddr sol)))
+          (if (member fix '("xfx" "xfy" "yfx"))
+              (setq res pre go nil)
+            (when (eq '! det)
+              (setq go nil)))
+        (setq go nil)))
+    (sweep-close-query)
+    res))
 
-(defun sweep-indent-line-ends-with-prefix-operator ()
-  (save-excursion
-    (end-of-line)
-    (skip-syntax-backward " ")
-    (when-let ((symbol (symbol-at-point)))
-      (when (member (symbol-name symbol) (sweep-prefix-operators))
-        (skip-syntax-backward "w_")
-        (+ (current-column) 4)))))
-
-(defun sweep-indent-line-ends-with-if ()
+(defun sweep-indent-line-after-functor (fbeg _fend)
   (save-excursion
-    (end-of-line)
-    (when-let ((start-of-ite (nth 1 (syntax-ppss))))
-      (when (<= (line-beginning-position) start-of-ite)
-        (goto-char start-of-ite)
-        (let ((col (current-column)))
-          (when (looking-at-p (rx "(   "))
-            col))))))
-
-(defun sweep-indent-line-ends-with-then (point)
-  (save-excursion
-    (when-let ((orig (save-mark-and-excursion
-                       (goto-char point)
-                       (back-to-indentation)
-                       (nth 1 (syntax-ppss))))
-               (start-of-ite (nth 1 (syntax-ppss))))
-      (when (= start-of-ite orig)
-        (back-to-indentation)
-        (let ((col (current-column)))
-          (when (looking-at-p (rx "->  "))
-            col))))))
-
-(defun sweep-indent-line-ends-with-else (point)
-  (save-excursion
-    (when-let ((orig (save-mark-and-excursion
-                       (goto-char point)
-                       (back-to-indentation)
-                       (nth 1 (syntax-ppss))))
-               (start-of-ite (nth 1 (syntax-ppss))))
-      (when (= start-of-ite orig)
-        (back-to-indentation)
-        (let ((col (current-column)))
-          (when (looking-at-p (rx ";   "))
-            col))))))
-
-(defun sweep-indent-line-ends-with-arg (point)
+    (goto-char fbeg)
+    (+ (current-column) 4)))
+
+(defun sweep-indent-line-after-open (fbeg _fend)
   (save-excursion
-    (end-of-line)
-    (when-let ((orig (save-mark-and-excursion
-                       (goto-char point)
-                       (back-to-indentation)
-                       (nth 1 (syntax-ppss))))
-               (start-of-ite (nth 1 (syntax-ppss))))
-      (when (= start-of-ite orig)
-        (goto-char start-of-ite)
-        (forward-char 1)
-        (skip-syntax-forward " ")
-        (current-column)))))
-
-(defun sweep-indent-line-ends-with-neck-p ()
+    (goto-char fbeg)
+    (+ (current-column) 4)))
+
+(defun sweep-indent-line-after-prefix (fbeg _fend _pre)
   (save-excursion
-    (looking-at-p (rx (zero-or-more (not "\n"))
-                      (or ":-" "=>" "-->")
-                      (zero-or-more blank)
-                      eol))))
+    (goto-char fbeg)
+    (+ (current-column) 4)))
+
+(defun sweep-indent-line-after-term ()
+  (if-let ((open (nth 1 (syntax-ppss))))
+      (save-excursion
+        (goto-char open)
+        (current-column))
+    'noindent))
 
-(defun sweep-indent-line-ends-with-comment-or-string-p ()
+(defun sweep-indent-line-after-neck (fbeg _fend)
   (save-excursion
-    (end-of-line)
-    (when-let ((beg (nth 8 (syntax-ppss))))
-      (<= beg (line-beginning-position)))))
+    (goto-char fbeg)
+    (sweep-backward-term 1200)
+    (+ (current-column) 4)))
 
-(defun sweep-indent-line-ends-with-fullstop-p ()
+(defun sweep-indent-line-after-infix (fbeg _fend pre)
   (save-excursion
-    (end-of-line)
-    (unless (nth 8 (syntax-ppss))
-      (= ?. (preceding-char)))))
+    (goto-char fbeg)
+    (let ((lim (or (nth 1 (syntax-ppss)) (point-min)))
+          (cur (point))
+          (go t))
+      (while go
+        (setq cur (point))
+        (sweep-backward-term pre)
+        (when (< (point) lim)
+          (goto-char cur))
+        (when (= (point) cur)
+          (setq go nil))))
+    (current-column)))
+
+(defun sweep-indent-line ()
+  (interactive)
+  (let ((pos (- (point-max) (point))))
+    (back-to-indentation)
+    (let ((indent (if (nth 8 (syntax-ppss))
+                      'noindent
+                    (pcase (sweep-last-token-boundaries)
+                      ('nil 'noindent)
+                      (`(functor ,lbeg ,lend)
+                       (sweep-indent-line-after-functor lbeg lend))
+                      (`(open ,lbeg ,lend)
+                       (sweep-indent-line-after-open lbeg lend))
+                      (`(symbol ,lbeg ,lend)
+                       (let ((sym (buffer-substring-no-properties lbeg lend)))
+                         (cond
+                          ((pcase (sweep-op-prefix-precedence sym)
+                             ('nil (sweep-indent-line-after-term))
+                             (pre  (sweep-indent-line-after-prefix lbeg lend pre)))))))
+                      (`(operator ,lbeg ,lend)
+                       (let ((op (buffer-substring-no-properties lbeg lend)))
+                         (cond
+                          ((string= op ".") 'noindent)
+                          ((pcase (sweep-op-infix-precedence op)
+                             ('nil nil)
+                             (1200 (sweep-indent-line-after-neck lbeg lend))
+                             (pre  (sweep-indent-line-after-infix lbeg lend pre))))
+                          ((pcase (sweep-op-prefix-precedence op)
+                             ('nil nil)
+                             (pre  (sweep-indent-line-after-prefix lbeg lend pre)))))))
+                      (`(,_ltyp ,_lbeg ,_lend)
+                       (sweep-indent-line-after-term))))))
+      (when (numberp indent)
+        (unless (= indent (current-column))
+          (combine-after-change-calls
+            (delete-horizontal-space)
+            (insert (make-string indent ? )))))
+      (when (> (- (point-max) pos) (point))
+        (goto-char (- (point-max) pos)))
+      indent)))
 
 (defun sweep-syntax-propertize (start end)
   (goto-char start)
@@ -1260,6 +1385,9 @@ Interactively, a prefix arg means to prompt for BUFFER."
     (funcall
      (syntax-propertize-rules
       ((rx bow (group-n 1 "0'" anychar))
+       (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+            (string-to-syntax "w"))))
+      ((rx (group-n 1 "!"))
        (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
             (string-to-syntax "w")))))
      start end)))
-- 
2.39.5