From: Eshel Yaron <me@eshelyaron.com>
Date: Sat, 13 Aug 2022 04:54:47 +0000 (+0300)
Subject: Checkpoint
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=83585436f51535e444ec98137993bc1feab69f7d;p=dotfiles.git

Checkpoint
---

diff --git a/.emacs.d/esy.org b/.emacs.d/esy.org
index 3829307..c15936d 100644
--- a/.emacs.d/esy.org
+++ b/.emacs.d/esy.org
@@ -782,7 +782,8 @@ refiling directly into deeper headings as well.
     (interactive)
     (pulse-momentary-highlight-one-line))
 
-  (add-to-list 'window-state-change-functions #'esy/pulse-line)
+  ; (add-to-list 'window-state-change-functions #'esy/pulse-line)
+
 #+end_src
 
 ** Misc. keybindings
diff --git a/.emacs.d/lisp/iprolog.el b/.emacs.d/lisp/iprolog.el
index f34da5f..98dde4b 100644
--- a/.emacs.d/lisp/iprolog.el
+++ b/.emacs.d/lisp/iprolog.el
@@ -37,15 +37,30 @@
   :type 'string
   :group 'iprolog)
 
+(defcustom iprolog-wants-flymake t
+  "Non-nil means `iprolog-mode' should integrate with `flymake-mode'."
+  :package-version '((iprolog . "0.1.0"))
+  :type 'boolean
+  :group 'iprolog)
+
+(defcustom iprolog-wants-eldoc t
+  "Non-nil means `iprolog-mode' should integrate with `eldoc'."
+  :package-version '((iprolog . "0.1.0"))
+  :type 'boolean
+  :group 'iprolog)
+
 (defun iprolog-beginning-of-defun-function (&optional arg)
   "Backend for `beginning-of-defun', which see for the meaning of ARG."
+  (font-lock-ensure)
   (let ((times (or arg 1)))
     (if (< times 0)
         (iprolog-beginning-of-next-defun (- times))
       (while (< 0 times)
         (goto-char (or (previous-single-property-change (point) 'iprolog-beginning-of-term) (point-min)))
         (unless (bobp) (backward-char))
-        (setq times (1- times))))))
+        (setq times (1- times)))))
+  (bobp))
+
 
 (defun iprolog-end-of-defun-function ()
   "Backend for `end-of-defun'."
@@ -56,7 +71,8 @@
     (when (get-text-property (point) 'iprolog-beginning-of-term)
       (forward-char))
     (goto-char (or (next-single-property-change (point) 'iprolog-beginning-of-term) (point-max)))
-    (setq times (1- times))))
+    (setq times (1- times)))
+  (eobp))
 
 (defun iprolog-text-property--find-beg-backward (property value)
   (iprolog-text-property--find-end-backward property value)
@@ -190,17 +206,23 @@
   (setq-local comment-start "%")
   (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
   (setq-local parens-require-spaces nil)
-  (add-hook 'flymake-diagnostic-functions #'iprolog--checker nil t)
-  (setq-local eldoc-documentation-strategy #'eldoc-documentation-default)
-  (add-hook 'eldoc-documentation-functions #'iprolog-predicate-modes-doc nil t)
+  (when iprolog-wants-flymake
+    (add-hook 'flymake-diagnostic-functions #'iprolog--checker nil t))
+  (when iprolog-wants-eldoc
+    (setq-local eldoc-documentation-strategy #'eldoc-documentation-default)
+    (add-hook 'eldoc-documentation-functions #'iprolog-predicate-modes-doc nil t))
   (add-hook 'completion-at-point-functions #'iprolog--atom-completion-at-point-function nil t)
+  ;; (add-hook 'post-self-insert-hook #'iprolog-post-self-insert-function nil t)
+  ;; (add-hook 'xref-backend-functions        ...)
   ;; (setq-local compile-command             ...)
   ;; (setq-local electric-indent-chars       ...)
   ;; (setq-local align-rules-alist           ...)
   ;; (setq-local imenu-create-index-function ...)
   ;; (setq-local indent-line-function        ...)
   ;; (setq-local indent-region-function      ...)
-  ;; (setq jit-lock-chunk-size 8192)
+  (setq-local fill-paragraph-function        #'iprolog-fill-paragraph-function)
+  ;; (setq-local fill-forward-paragraph-function     ...)
+  (setq jit-lock-chunk-size               8192)
   (setq-local beginning-of-defun-function #'iprolog-beginning-of-defun-function)
   (setq-local end-of-defun-function #'iprolog-end-of-defun-function)
   (setq-local font-lock-defaults
@@ -209,7 +231,8 @@
                 nil
                 nil
                 (font-lock-fontify-region-function . iprolog-fontify-region)
-                (font-lock-extra-managed-props       (iprolog-beginning-of-term)))))
+                (font-lock-extra-managed-props       iprolog-beginning-of-term
+                                                     ))))
 
 ;;;; project.el integration
 
@@ -248,14 +271,50 @@ value of `iprolog-project-definition-file-name'."
 
 (defun iprolog-project--name ()
   "Return the name of the current Prolog project."
-  (let ((default-directory (project-root (project-current))))
-    (iprolog--execute-to-string "consult(pack), name(N), write(N)")))
+  (let ((default-directory (or (iprolog-project--root)
+                               default-directory)))
+    (if (file-exists-p (expand-file-name "pack.pl" default-directory))
+        (iprolog--execute-to-string "consult(pack), name(N), write(N)")
+      "")))
 
 (defun iprolog-project--version ()
   "Return the version of the current Prolog project, as a string."
-  (let ((default-directory (project-root (project-current))))
-    (iprolog--execute-to-string "consult(pack), version(N), write(N)")))
-
+  (let ((default-directory (or (iprolog-project--root)
+                               default-directory)))
+    (if (file-exists-p (expand-file-name "pack.pl" default-directory))
+        (iprolog--execute-to-string "consult(pack), version(N), write(N)")
+      "")))
+
+
+;;;; autotyping
+
+(defconst iprolog--atom-regexp (rx (seq line-start (or lower "'") (* anychar)))
+  "Regular expression recognizing atoms.")
+
+(defun iprolog-read-term ()
+  (let ((token (iprolog-read-token)))
+    token))
+
+(defun iprolog-read-token ()
+  (let ((string (read-string "?- ")))
+    (cond
+     ((string-match iprolog--atom-regexp string nil t)
+      (list 'atom string)))))
+
+(defun iprolog-post-self-insert-function ()
+  (when (and (not (memq last-command-event '(?\s ?\n)))
+             (not (get-text-property (point) 'iprolog-beginning-of-term))
+             (not (eq 'iprolog-syntax-error-face (get-text-property (1- (point)) 'font-lock-face)))
+             (not (eq 'iprolog-fullstop-face (get-text-property (1- (point)) 'font-lock-face)))
+             (< (save-mark-and-excursion
+                  (iprolog-text-property--find-end-backward 'iprolog-beginning-of-term t)
+                  (point))
+                (save-mark-and-excursion
+                  (iprolog-text-property--find-end-backward 'font-lock-face 'iprolog-fullstop-face)
+                  (point))))
+    (insert ". ")
+    (backward-char 2))
+  (remove-text-properties (1- (point)) (point)  '(font-lock-face iprolog-beginning-of-term)))
 
 ;;;; top-level
 
@@ -504,41 +563,35 @@ Also start a Prolog server listening on UDP port PORT."
   "Flymake backend function for Prolog projects.
 REPORT-FN is the reporting function passed to backend by Flymake,
 as documented in `flymake-diagnostic-functions', ARGS"
-  (let* ((end      (when-let ((pos (plist-get args :changes-end)))
-                     (save-mark-and-excursion
-                       (save-match-data
-                         (goto-char pos)
-                         (end-of-defun)
-                         (point)))))
-         (start    (if-let ((pos (plist-get args :changes-start)))
-                       (save-mark-and-excursion
-                         (save-match-data
-                           (goto-char pos)
-                           (beginning-of-defun-comments)
-                           (point)))
-                     (point-min)))
-         (buffer   (current-buffer))
-         (tempfile (make-temp-file "iprolog--checker")))
-    (with-temp-file tempfile
-      (insert-buffer-substring buffer start end))
-    (iprolog--request-goal-output
-     (concat "'" (buffer-file-name buffer) "' = Path, catch([Path], _, true), diagnose(Path,'"  tempfile "')")
-     (if end
-         (lambda (o)
-           (with-current-buffer buffer
-             (funcall report-fn
-                      (or (delq nil
-                                (seq-map
-                                 (lambda (line)
-                                   (iprolog--parse-diagnostic line start))
-                                 (string-lines o t)))
-                          nil)
-                      :region (cons start end))))
-       (lambda (o)
-         (with-current-buffer buffer
-           (dolist (line (string-lines o t))
-             (when-let ((diag (iprolog--parse-diagnostic line start)))
-               (funcall report-fn (list diag)))))))))
+  (let ((diags nil)
+        (end (save-mark-and-excursion
+               (save-match-data
+                 (goto-char (or (plist-get args :changes-end) (point-min)))
+                 (end-of-defun 2)
+                 (point)))))
+    (save-mark-and-excursion
+      (save-match-data
+        (goto-char (or (plist-get args :changes-start) (point-min)))
+        (beginning-of-defun)
+        (let ((beg (point)))
+          (font-lock-ensure beg end)
+          (while (< (point) end)
+            (when-let ((diag (pcase (get-text-property (point) 'font-lock-face)
+                               ('iprolog-syntax-error-face
+                                (let ((wbeg (point)))
+                                  (goto-char (or (next-single-property-change (point) 'font-lock-face) end))
+                                  (flymake-make-diagnostic (current-buffer) wbeg (point) :error "Syntax error")))
+                               ('iprolog-instantiation-error-face
+                                (let ((wbeg (point)))
+                                  (goto-char (or (next-single-property-change (point) 'font-lock-face) end))
+                                  (flymake-make-diagnostic (current-buffer) wbeg (point) :warning "Instantiation error")))
+                               ('iprolog-singleton-face
+                                (let ((wbeg (point)))
+                                  (goto-char (or (next-single-property-change (point) 'font-lock-face) end))
+                                  (flymake-make-diagnostic (current-buffer) wbeg (point) :warning "Singleton variable"))))))
+              (setq diags (cons diag diags)))
+            (goto-char (or (next-single-property-change (point) 'font-lock-face) end)))
+          (funcall report-fn diags :region (cons beg end))))))
   t)
 
 
@@ -729,6 +782,9 @@ explanation about the argument CALLBACK."
          ((string= type "clause")
           (put-text-property beg (1+ beg) 'iprolog-beginning-of-term t)
           '(nil t))
+         ((string= type "term")
+          (put-text-property beg (1+ beg) 'iprolog-beginning-of-term t)
+          '(nil t))
          ((string= type "directive")
           (put-text-property beg (1+ beg) 'iprolog-beginning-of-term t)
           '(nil t))
@@ -790,8 +846,7 @@ explanation about the argument CALLBACK."
           (list iprolog-foreign-face nil))
          ((string-match (rx (seq line-start
                                  "goal(built_in"
-                                 (+ anychar)
-                                 ")"))
+                                 (+ anychar)))
                         type nil t)
           (list iprolog-built-in-face nil))
          ((string-match (rx (seq line-start
@@ -880,37 +935,82 @@ explanation about the argument CALLBACK."
         (buffer (current-buffer))
         (default-directory (or (iprolog-project--root)
                                default-directory)))
-    (when loudly (message "fontifying %s-%s" beg end))
-    (font-lock-unfontify-region beg end)
+    (message "(re)fontifying from %s to %s %s %s" beg end (point-min) (point-max))
     (iprolog--ensure-top-level)
-    (let* ((tempfile (make-temp-file
-                      "iprolog--fontify"
-                      nil
-                      ".pl")))
-      (with-temp-file tempfile
-        (insert-buffer-substring buffer beg end))
-      (iprolog--request-goal-output
-       (concat "\"" (buffer-file-name buffer) "\"= Orig,"
-               "\"" tempfile "\"= Path,"
-               "ensure_loaded(Orig), xref_source(Orig), (source_file_property(Orig, module(Module)) -> true ; Module = prolog_colour), debug(iprolog, \"fontifying ~w as ~w\", [Path, Module]), setup_call_cleanup(prolog_open_source(Path, Stream), @(prolog_colourise_stream(Stream, Orig, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T])), Module), prolog_close_source(Stream))")
-       (lambda (o)
-         (with-current-buffer buffer
-           (with-silent-modifications
-             (dolist (line (string-lines o t))
-               (when-let ((f (iprolog--parse-fontification-line line beg)))
-                 (let ((fs (car f))
-                       (fe (cadr f))
-                       (ff (caddr f))
-                       (fm (cadddr f)))
-                   (if ff
-                       (put-text-property fs fe 'font-lock-face ff)
-                     ;; (remove-text-properties fs fe '(font-lock-face))
-                     )
-                   (when fm
-                     (put-text-property fs fe 'font-lock-multiline t)))))))
-         (delete-file tempfile))))
-    (font-lock-fontify-keywords-region beg end loudly)
+    (if (and (= beg (point-min))
+             (= end (point-max))
+             (not (buffer-modified-p)))
+        (iprolog--request-goal-output
+         (concat "'" (buffer-file-name buffer) "' = Orig,"
+                 "ensure_loaded(Orig), xref_source(Orig), setup_call_cleanup(prolog_open_source(Orig, Stream), prolog_colourise_stream(Stream, Orig, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T])), prolog_close_source(Stream))")
+         (lambda (o)
+           (with-current-buffer buffer
+             (with-silent-modifications
+               (save-mark-and-excursion
+                 (font-lock-unfontify-buffer)
+                 (dolist (line (string-lines o t))
+                   (when-let ((f (iprolog--parse-fontification-line line beg)))
+                     (let ((fs (car f))
+                           (fe (cadr f))
+                           (ff (caddr f))
+                           (fm (cadddr f)))
+                       (when ff
+                         (put-text-property fs fe 'font-lock-face ff))
+                       (when fm
+                         (put-text-property fs fe 'font-lock-multiline t)))))
+                 (font-lock-fontify-keywords-region (point-min) (point-max) loudly))))))
+      (let* ((tempfile (make-temp-file
+                        "iprolog--fontify"
+                        nil
+                        ".pl")))
+        (with-temp-file tempfile
+          (insert-buffer-substring buffer beg end))
+        (iprolog--request-goal-output
+         (concat "'" (buffer-file-name buffer) "' = Orig,"
+                 "\"" tempfile "\"= Path,"
+                 "ensure_loaded(Orig), xref_source(Orig), setup_call_cleanup(prolog_open_source(Path, Stream), (repeat, once(prolog_colourise_term(Stream, O, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T]), [])), at_end_of_stream(Stream), !), prolog_close_source(Stream))")
+         (lambda (o)
+           (with-current-buffer buffer
+             (font-lock-unfontify-region beg end)
+             (with-silent-modifications
+               (save-mark-and-excursion
+                 (dolist (line (string-lines o t))
+                   (when-let ((f (iprolog--parse-fontification-line line beg)))
+                     (let ((fs (car f))
+                           (fe (cadr f))
+                           (ff (caddr f))
+                           (fm (cadddr f)))
+                       (when ff
+                         (put-text-property fs fe 'font-lock-face ff))
+                       (when fm
+                         (put-text-property fs fe 'font-lock-multiline t)))))
+                 (font-lock-fontify-keywords-region beg end loudly))))
+           (delete-file tempfile)))))
     `(jit-lock-bounds ,beg . ,end)))
 
 
+;;; fill-paragraph
+
+(defun iprolog--portray-term (s)
+  (iprolog--request-goal-sync (concat "term_string(T," (prin1-to-string s) ",[variable_names(VN)]),"
+                                      "portray_clause(current_output, T, [variable_names(VN)])")))
+
+(defun iprolog-portray-and-insert-term (s)
+  (interactive "sTerm: " iprolog-mode)
+  (insert (iprolog--portray-term s)))
+
+(defun iprolog-fill-paragraph-function (&optional _justify)
+  (let* ((start (save-mark-and-excursion
+                  (beginning-of-defun)
+                  (point)))
+         (end (save-mark-and-excursion
+                (end-of-defun)
+                (point)))
+         (term (buffer-substring-no-properties start end))
+         (port (iprolog--portray-term term)))
+    (when port
+      (goto-char start)
+      (delete-region start end)
+      (insert port))))
+
 ;;; iprolog.el ends here