From 88f31470a559227ade9c9c2b1bb1facaedec4764 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 14 Aug 2022 21:40:20 +0300 Subject: [PATCH] Checkpoint --- .emacs.d/lisp/iprolog.el | 623 +++++++++++++++++++++++---------------- 1 file changed, 365 insertions(+), 258 deletions(-) diff --git a/.emacs.d/lisp/iprolog.el b/.emacs.d/lisp/iprolog.el index 2fec8ac..8976547 100644 --- a/.emacs.d/lisp/iprolog.el +++ b/.emacs.d/lisp/iprolog.el @@ -23,7 +23,7 @@ "Editing and running Prolog code." :group 'prolog) -(defcustom iprolog-program "/Users/eshelyaron/checkouts/iprolog/iprolog" +(defcustom iprolog-program "swipl" "The Prolog executable." :package-version '((iprolog . "0.1.0")) ;; :link '(custom-manual "(iprolog)Top") @@ -52,6 +52,7 @@ (defun iprolog-beginning-of-defun-function (&optional arg) "Backend for `beginning-of-defun', which see for the meaning of ARG." (font-lock-ensure) + (iprolog-font-lock-ensure-function) (let ((times (or arg 1))) (if (< times 0) (iprolog-beginning-of-next-defun (- times)) @@ -64,7 +65,9 @@ (defun iprolog-end-of-defun-function () "Backend for `end-of-defun'." - (iprolog-text-property--find-end-forward 'font-lock-face 'iprolog-fullstop-face)) + (goto-char (or (next-single-property-change (point) 'iprolog-end-of-term) (point-max))) + (unless (eobp) + (forward-char 1))) (defun iprolog-beginning-of-next-defun (times) (while (< 0 times) @@ -144,11 +147,9 @@ "Save this buffer and load it into the current Prolog session." (interactive nil iprolog-mode) (save-buffer) - (iprolog--request-goal-output (concat "ensure_loaded(\"" - (buffer-file-name) - "\")") - (lambda (_) - (message "iprolog: buffer loaded.")))) + (iprolog--request (concat "ensure_loaded(\"" + (buffer-file-name) + "\")"))) ;; (defun iprolog-eval-dwim (&optional insert) ;; (interactive "P" iprolog-mode) @@ -206,12 +207,13 @@ (setq-local comment-start "%") (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)") (setq-local parens-require-spaces nil) - (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) + ;; (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 'after-change-functions #'iprolog-after-change-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 ...) @@ -220,9 +222,9 @@ ;; (setq-local imenu-create-index-function ...) ;; (setq-local indent-line-function ...) ;; (setq-local indent-region-function ...) - (setq-local fill-paragraph-function #'iprolog-fill-paragraph-function) + ;; (setq-local fill-paragraph-function #'iprolog-fill-paragraph-function) ;; (setq-local fill-forward-paragraph-function ...) - (setq jit-lock-chunk-size 8192) + ;; (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 @@ -230,9 +232,18 @@ t nil nil + (font-lock-support-mode) (font-lock-fontify-region-function . iprolog-fontify-region) (font-lock-extra-managed-props iprolog-beginning-of-term - )))) + button + follow-link + category + button-data + mouse-face + keymap + action + help-echo + iprolog-end-of-term)))) ;;;; project.el integration @@ -329,6 +340,8 @@ value of `iprolog-project-definition-file-name'." (defvar-local iprolog--pending-requests (make-ring 128)) +(defvar-local iprolog--pending-data nil) + (defvar-local iprolog--last-request-id 0) (defvar-local iprolog--sync-output nil) @@ -343,7 +356,7 @@ value of `iprolog-project-definition-file-name'." (unless (process-live-p iprolog--buffer-server-process) (setq iprolog--buffer-server-process (make-network-process - :name "iprolog_buffer_server" + :name "iprolog-buffer-server" :local `[127 0 0 1 ,(setq iprolog--last-buffer-server-port (1+ iprolog--last-buffer-server-port))] :coding 'utf-8 :server 5 @@ -354,15 +367,20 @@ value of `iprolog-project-definition-file-name'." (goto-char (point-max)) (insert (format "%s %s %s" server client message)))) :sentinel - (lambda (proc state) - (message "update %s: %s" proc state)) + (lambda (_proc _state)) :filter (lambda (proc output) - (message "serving %s to %s" output proc) (save-excursion - (with-current-buffer (find-file-noselect (car (string-lines output))) - (process-send-region proc (point-min) (point-max)) - (process-send-eof proc)))))))) + (let* ((lines (string-lines output)) + (path (car lines) ) + (beg0 (string-to-number (cadr lines))) + (end0 (string-to-number (caddr lines)))) + (with-current-buffer (find-file-noselect path) + (let ((beg (or (and (< 0 beg0) beg0) (point-min))) + (end (or (and (< 0 end0) end0) (point-max)))) + (condition-case _ + (progn (process-send-region proc beg end) + (process-send-eof proc)))))))))))) (defun iprolog--ensure-top-level () (if-let ((buffer (iprolog--top-level-buffer))) @@ -395,20 +413,6 @@ value of `iprolog-project-definition-file-name'." (iprolog-top-level-mode) (iprolog--make-top-level (current-buffer)))) -(defun iprolog--make-top-level-old (buffer) - "Create a Prolog top-level process in BUFFER." - (make-comint-in-buffer - "top-level" buffer iprolog-program nil - "-q" - "-g" "[library(pldoc)]" - "-g" "[library(pldoc/doc_process)]" - "-g" "[library(pldoc/doc_wiki)]" - "-g" "[library(pldoc/doc_modes)]" - "-g" "[library(pldoc/doc_man)]" - "-g" "[library(lynx/html_text)]" - "-g" "[library(diagnostics)]" - "-t" "prolog")) - (defun iprolog--make-top-level (buffer) (iprolog-top-level--start-in-buffer buffer (setq iprolog--last-helper-port @@ -418,9 +422,11 @@ value of `iprolog-project-definition-file-name'." (defun iprolog-top-level--start-in-buffer (buffer port server-port) "Create a Prolog top-level process in BUFFER. -Also start a Prolog server listening on UDP port PORT." +Also start a Prolog server listening on UDP port PORT, +SERVER-PORT." + (iprolog--ensure-buffer-server) (make-comint-in-buffer - "top-level" buffer iprolog-program nil "-u" (number-to-string port) "-e" (number-to-string server-port) "-b" (number-to-string iprolog--last-buffer-server-port)) + "top-level" buffer iprolog-program nil "/Users/eshelyaron/checkouts/iprolog/prolog/iprolog.pl" "--" "-u" (number-to-string port) "-e" (number-to-string server-port) "-b" (number-to-string iprolog--last-buffer-server-port)) (setq iprolog--server-process (make-network-process :name "iprolog_server" @@ -435,11 +441,20 @@ Also start a Prolog server listening on UDP port PORT." (insert (format "%s %s %s" server client message)))) :sentinel (lambda (proc state) - (message "update %s: %s" proc state)) - :filter - (lambda (proc output) - (message "got %s from %s" output proc)))) - (setq iprolog--helper-connection + (when (string= state "connection broken by remote peer\n") + (with-silent-modifications + (with-current-buffer (process-buffer proc) + (save-mark-and-excursion + (goto-char (point-min)) + (end-of-line) + (let* ((id (string-to-number (buffer-substring (point-min) (point)))) + (cb (alist-get id (ring-elements (with-current-buffer buffer iprolog--pending-requests))))) + (delete-line) + (when cb + (funcall cb)) + (unless (process-live-p proc) + (kill-buffer)))))))))) + (setq iprolog--helper-connection (make-network-process :name "iprolog_helper" :host 'local @@ -459,7 +474,7 @@ Also start a Prolog server listening on UDP port PORT." (funcall (car cd) (cdr cd)))))) buffer) -(defun iprolog--request-goal-output (goal cb) +(defun iprolog--request (goal &optional cb) "Request evaluation of GOAL, setting up CB to handle its output." (let ((default-directory (or (iprolog-project--root) default-directory))) @@ -467,12 +482,14 @@ Also start a Prolog server listening on UDP port PORT." (with-current-buffer (iprolog--top-level-buffer) (setq iprolog--last-request-id (1+ iprolog--last-request-id)) - (ring-insert iprolog--pending-requests - (cons iprolog--last-request-id cb)) + (when cb + (ring-insert iprolog--pending-requests + (cons iprolog--last-request-id cb))) (process-send-string iprolog--helper-connection (concat (number-to-string iprolog--last-request-id) " :- " goal))))) + (defun iprolog--request-goal-sync (goal) "Request evaluation of GOAL and return output its as a string." (let ((default-directory (or (iprolog-project--root) @@ -481,7 +498,7 @@ Also start a Prolog server listening on UDP port PORT." (let ((buffer (iprolog--top-level-buffer))) (with-current-buffer buffer (setq iprolog--sync-output nil) - (iprolog--request-goal-output goal + (iprolog--request goal (lambda (o) (with-current-buffer buffer (setq iprolog--sync-output o)))) @@ -566,6 +583,7 @@ Also start a Prolog server listening on UDP port PORT." comint-input-filter (lambda (s) (< 3 (length s)))) (comint-read-input-ring t) ;; (add-hook 'comint-preoutput-filter-functions ...) + ;; (setq-local 'bookmark-make-record-function ...) (add-hook 'comint-exec-hook #'iprolog-top-level--on-exec nil t) (setq read-process-output-max 49152) (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t) @@ -646,7 +664,7 @@ explanation about the argument CALLBACK." (save-mark-and-excursion (save-match-data (when-let ((sym (iprolog--atom-at-point))) - (iprolog--request-goal-output + (iprolog--request (concat "forall((doc_comment(M:(" sym @@ -728,24 +746,93 @@ explanation about the argument CALLBACK." (iprolog-defface comment font-lock-comment-face "Comments.") -(iprolog-defface head font-lock-builtin-face - "Heads.") +(iprolog-defface head-local font-lock-builtin-face + "Local predicate definitions.") + +(iprolog-defface head-meta font-lock-preprocessor-face + "Meta predicate definitions.") + +(iprolog-defface head-multifile font-lock-type-face + "Multifile predicate definitions.") + +(iprolog-defface head-extern font-lock-type-face + "External predicate definitions.") + +(iprolog-defface head-unreferenced font-lock-warning-face + "Unreferenced predicate definitions.") + +(iprolog-defface head-exported font-lock-builtin-face + "Exported predicate definitions.") + +(iprolog-defface head-hook font-lock-type-face + "Hook definitions.") + +(iprolog-defface head-iso font-lock-keyword-face + "Hook definitions.") + +(iprolog-defface head-undefined font-lock-warning-face + "Undefind head terms.") + +(iprolog-defface head-public font-lock-builtin-face + "Public definitions.") + +(iprolog-defface meta-spec font-lock-preprocessor-face + "Meta argument specifiers.") (iprolog-defface recursion font-lock-builtin-face "Recursive calls.") +(iprolog-defface local font-lock-function-name-face + "Local predicate calls.") + +(iprolog-defface autoload font-lock-function-name-face + "Autoloaded predicate calls.") + +(iprolog-defface imported font-lock-function-name-face + "Imported predicate calls.") + +(iprolog-defface extern font-lock-function-name-face + "External predicate calls.") + (iprolog-defface foreign font-lock-keyword-face "Foreign predicate calls.") (iprolog-defface meta font-lock-type-face "Meta predicate calls.") +(iprolog-defface undefined font-lock-warning-face + "Undefined predicate calls.") + +(iprolog-defface thread-local font-lock-constant-face + "Thread local predicate calls.") + +(iprolog-defface global font-lock-keyword-face + "Global predicate calls.") + +(iprolog-defface multifile font-lock-function-name-face + "Multifile predicate calls.") + +(iprolog-defface dynamic font-lock-constant-face + "Dynamic predicate calls.") + +(iprolog-defface undefined-import font-lock-warning-face + "Undefined imports.") + +(iprolog-defface html-attribute font-lock-function-name-face + "HTML attributes.") + +(iprolog-defface html-call font-lock-keyword-face + "Multifile predicate calls.") + (iprolog-defface option-name font-lock-constant-face "Option names.") (iprolog-defface flag-name font-lock-constant-face "Flag names.") +(iprolog-defface no-flag-name font-lock-warning-face + "Non-existent flag names.") + (iprolog-defface qq-type font-lock-type-face "Quasi-quotation types.") @@ -758,6 +845,9 @@ explanation about the argument CALLBACK." (iprolog-defface dict-key font-lock-keyword-face "Dict keys.") +(iprolog-defface dict-sep font-lock-keyword-face + "Dict separators.") + (iprolog-defface type-error font-lock-warning-face "Type errors.") @@ -767,9 +857,21 @@ explanation about the argument CALLBACK." (iprolog-defface file button "File specifiers.") +(iprolog-defface no-file font-lock-warning-face + "Non-existent file specifiers.") + +(iprolog-defface file-no-depend font-lock-warning-face + "Unused file specifiers.") + +(iprolog-defface unused-import font-lock-warning-face + "Unused imports.") + (iprolog-defface identifier font-lock-type-face "Identifiers.") +(iprolog-defface hook font-lock-preprocessor-face + "Hooks.") + (iprolog-defface module font-lock-type-face "Module names.") @@ -785,6 +887,9 @@ explanation about the argument CALLBACK." (iprolog-defface variable font-lock-variable-name-face "Variables.") +(iprolog-defface ext-quant font-lock-keyword-face + "Existential quantifiers.") + (iprolog-defface control font-lock-keyword-face "Control constructs.") @@ -794,6 +899,12 @@ explanation about the argument CALLBACK." (iprolog-defface int font-lock-constant-face "Integers.") +(iprolog-defface float font-lock-constant-face + "Floats.") + +(iprolog-defface codes font-lock-constant-face + "Codes.") + (iprolog-defface error font-lock-warning-face "Unspecified errors.") @@ -815,219 +926,208 @@ explanation about the argument CALLBACK." (let* ((beg (+ (string-to-number (match-string 1 line)) start)) (end (+ beg (string-to-number (match-string 2 line)))) (type (match-string 3 line))) - (cons - beg - (cons - end - (cond - ((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)) - ((string= type "grammar_rule") - (put-text-property beg (1+ beg) 'iprolog-beginning-of-term t) - '(nil t)) - ((string= type "comment(structured)") - (list iprolog-structured-comment-face t)) - ((string= type "comment(string)") - (list iprolog-comment-face t)) - ((string= type "comment(block)") - (list iprolog-comment-face t)) - ((string= type "string") - (list iprolog-string-face t)) - ((string= type "predicate_indicator") - (list iprolog-predicate-indicator-face nil)) - ((string= type "arity") - (list iprolog-arity-face nil)) - ((string= type "functor") - (list iprolog-functor-face nil)) - ((string-match (rx (seq line-start - "file(" - (+ anychar) - ")")) - type nil t) - (save-match-data - (string-match (rx (seq line-start "file(" (group (+ anychar)) ")")) type) - (buttonize-region beg end #'find-file (match-string 1 type) "Find file")) - (list iprolog-file-face nil)) - ((string-match (rx (seq line-start - "head(" - (+ anychar) - ")")) - type nil t) - (list iprolog-head-face nil)) - ((string-match (rx (seq line-start - "goal(recursion" - (+ anychar) - ")")) - type nil t) - (list iprolog-recursion-face nil)) - ((string-match (rx (seq line-start - "goal(meta" - (+ anychar) - ")")) - type nil t) - (list iprolog-meta-face nil)) - ((string-match (rx (seq line-start - "goal(meta" - (+ anychar) - ")")) - type nil t) - (list iprolog-meta-face nil)) - ((string-match (rx (seq line-start - "goal(foreign" - (+ anychar) - ")")) - type nil t) - (list iprolog-foreign-face nil)) - ((string-match (rx (seq line-start - "goal(built_in" - (+ anychar))) - type nil t) - (list iprolog-built-in-face nil)) - ((string-match (rx (seq line-start - "goal(" - (+ anychar) - ")")) - type nil t) - (list iprolog-goal-face nil)) - ((string= type "dict_tag") - (list iprolog-dict-tag-face nil)) - ((string= type "dict_key") - (list iprolog-dict-key-face nil)) - ((string= type "qq_type") - (list iprolog-qq-type-face nil)) - ((string= type "instantiation_error") - (list iprolog-instantiation-error-face nil)) - ((string-match (rx (seq line-start - "type_error(" - (+ anychar) - ")")) - type nil t) - (list iprolog-type-error-face nil)) - ((string-match (rx (seq line-start - "op_type(" - (+ anychar) - ")")) - type nil t) - (list iprolog-op-type-face nil)) - ((string-match (rx (seq line-start - "flag_name(" - (+ anychar) - ")")) - type nil t) - (list iprolog-goal-face nil)) - ((string= type "option_name") - (list iprolog-option-name-face nil)) - ((string= type "comment(line)") - (list iprolog-comment-face nil)) - ((string-match (rx (seq line-start - "neck(" - (+ anychar) - ")")) - type nil t) - (list iprolog-neck-face nil)) - ((string= type "var") - (list iprolog-variable-face nil)) - ((string= type "empty_list") - (list iprolog-nil-face nil)) - ((string= type "fullstop") - (list iprolog-fullstop-face nil)) - ((string= type "control") - (list iprolog-control-face nil)) - ((string= type "atom") - (list iprolog-atom-face nil)) - ((string= type "int") - (list iprolog-int-face nil)) - ((string= type "error") - (list iprolog-error-face nil)) - ((string-match (rx (seq line-start - "syntax_error(" - (+ anychar) - ")")) - type nil t) - (list iprolog-syntax-error-face t)) - ((string= type "singleton") - (list iprolog-singleton-face t)) - ((string-match (rx (seq line-start - "module(" - (+ anychar) - ")")) - type nil t) - (list iprolog-module-face nil)) - ((string= type "identifier") - (list iprolog-identifier-face nil)))))))) - + (cond + ((string-match (rx (seq line-start (or "clause" "term" "directive" "grammar_rule"))) type nil t) + `((,beg ,(1+ beg) iprolog-beginning-of-term t) + (,end ,(1+ end) iprolog-end-of-term t) + (,beg ,end font-lock-face default))) + ((string= type "comment(structured)") + `((,beg ,end font-lock-face ,iprolog-structured-comment-face))) + ((string-match (rx (seq line-start "comment(" (or "line" "block" "string") ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-comment-face))) + ((string= type "string") + `((,beg ,end font-lock-face ,iprolog-string-face))) + ((string= type "predicate_indicator") + `((,beg ,end font-lock-face ,iprolog-predicate-indicator-face))) + ((string= type "arity") + `((,beg ,end font-lock-face ,iprolog-arity-face))) + ((string= type "functor") + `((,beg ,end font-lock-face ,iprolog-functor-face))) + ((string-match (rx (seq line-start "file_no_depend(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-file-no-depend-face))) + ((string-match (rx (seq line-start "nofile")) type nil t) + `((,beg ,end font-lock-face ,iprolog-no-file-face))) + ((string-match (rx (seq line-start "file(" (+ anychar) ")")) type nil t) + (let ((file-path (save-match-data + (string-match (rx (seq line-start "file('" (group (+ anychar)) "')")) type) + (match-string 1 type)))) + `((,beg ,end font-lock-face ,iprolog-file-face) + (,beg ,end button ,t) + (,beg ,end follow-link ,t) + (,beg ,end category ,t) + (,beg ,end button-data ,file-path) + (,beg ,end mouse-face highlight) + (,beg ,end keymap ,button-map) + (,beg ,end action find-file) + (,beg ,end help-echo ,(concat "Find " file-path))))) + ((string-match (rx (seq line-start "head(undefined" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-undefined-face))) + ((string-match (rx (seq line-start "head((public" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-public-face))) + ((string-match (rx (seq line-start "head(iso" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-iso-face))) + ((string-match (rx (seq line-start "head(hook" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-hook-face))) + ((string-match (rx (seq line-start "head((multifile" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-multifile-face))) + ((string-match (rx (seq line-start "head(exported" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-exported-face))) + ((string-match (rx (seq line-start "head(local" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-local-face))) + ((string-match (rx (seq line-start "head(meta" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-meta-face))) + ((string-match (rx (seq line-start "head(extern" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-extern-face))) + ((string-match (rx (seq line-start "head(unreferenced" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-head-unreferenced-face))) + ((string-match (rx (seq line-start "meta(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-meta-spec-face))) + ((string-match (rx (seq line-start "goal(recursion" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-recursion-face))) + ((string-match (rx (seq line-start "goal(meta" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-meta-face))) + ((string-match (rx (seq line-start "goal(foreign" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-foreign-face))) + ((string-match (rx (seq line-start "goal(built_in" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-built-in-face))) + ((string-match (rx (seq line-start "goal(local" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-local-face))) + ((string-match (rx (seq line-start "goal(imported" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-imported-face))) + ((string-match (rx (seq line-start "goal(autoload" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-autoload-face))) + ((string-match (rx (seq line-start "goal(extern" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-extern-face))) + ((string-match (rx (seq line-start "goal(undefined" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-undefined-face))) + ((string-match (rx (seq line-start "goal(global" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-global-face))) + ((string-match (rx (seq line-start "goal((thread_local" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-thread-local-face))) + ((string-match (rx (seq line-start "goal((multifile" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-multifile-face))) + ((string-match (rx (seq line-start "goal((dynamic" (+ anychar))) type nil t) + `((,beg ,end font-lock-face ,iprolog-dynamic-face))) + ((string= type "unused_import") + `((,beg ,end font-lock-face ,iprolog-unused-import-face))) + ((string= type "undefined_import") + `((,beg ,end font-lock-face ,iprolog-undefined-import-face))) + ((string= type "dict_tag") + `((,beg ,end font-lock-face ,iprolog-dict-tag-face))) + ((string= type "dict_key") + `((,beg ,end font-lock-face ,iprolog-dict-key-face))) + ((string= type "qq_type") + `((,beg ,end font-lock-face ,iprolog-qq-type-face))) + ((string= type "instantiation_error") + `((,beg ,end font-lock-face ,iprolog-instantiation-error-face))) + ((string-match (rx (seq line-start "type_error(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-type-error-face))) + ((string-match (rx (seq line-start "op_type(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-op-type-face))) + ((string-match (rx (seq line-start "flag_name(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-flag-name-face))) + ((string-match (rx (seq line-start "no_flag_name(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-no-flag-name-face))) + ((string= type "option_name") + `((,beg ,end font-lock-face ,iprolog-option-name-face))) + ((string-match (rx (seq line-start "neck(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-neck-face))) + ((string= type "var") + `((,beg ,end font-lock-face ,iprolog-variable-face))) + ((string= type "empty_list") + `((,beg ,end font-lock-face ,iprolog-nil-face))) + ((string= type "fullstop") + `((,beg ,end font-lock-face ,iprolog-fullstop-face))) + ((string= type "ext_quant") + `((,beg ,end font-lock-face ,iprolog-ext-quant-face))) + ((string= type "control") + `((,beg ,end font-lock-face ,iprolog-control-face))) + ((string= type "dict_sep") + `((,beg ,end font-lock-face ,iprolog-dict-sep-face))) + ((string-match (rx (seq line-start "html_attribute(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-html-attribute-face))) + ((string= type "html_call") + `((,beg ,end font-lock-face ,iprolog-html-call-face))) + ((string= type "atom") + `((,beg ,end font-lock-face ,iprolog-atom-face))) + ((string= type "float") + `((,beg ,end font-lock-face ,iprolog-float-face))) + ((string= type "codes") + `((,beg ,end font-lock-face ,iprolog-float-face))) + ((string= type "int") + `((,beg ,end font-lock-face ,iprolog-int-face))) + ((string= type "error") + `((,beg ,end font-lock-face ,iprolog-error-face))) + ((string-match (rx (seq line-start "syntax_error(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-syntax-error-face))) + ((string= type "singleton") + `((,beg ,end font-lock-face ,iprolog-singleton-face))) + ((string-match (rx (seq line-start "module(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-module-face))) + ((string-match (rx (seq line-start "hook(" (+ anychar) ")")) type nil t) + `((,beg ,end font-lock-face ,iprolog-hook-face))) + ((string= type "identifier") + `((,beg ,end font-lock-face ,iprolog-identifier-face))) + ((string-match (rx (seq line-start (or "brace_term" + "rule_condition" + "parentheses" + "html(" + "body" + "expanded" + "exported_operator" + "dict" + "goal_term(" + "list" + "predicate_indicator(" + "dcg" + "head_term(" + ))) + type nil t) + nil) + (t (message "Unrecognized color term %s at %s-%s" type beg end) + nil))))) + + +(defvar-local iprolog-fontifying nil) (defun iprolog-fontify-region (beg0 end0 loudly) - (let ((beg (save-excursion - (goto-char beg0) - (beginning-of-defun 2) - (point))) - (end (save-excursion - (goto-char end0) - (beginning-of-defun -2) - (point))) - (buffer (current-buffer)) - (default-directory (or (iprolog-project--root) - default-directory))) - (iprolog--ensure-top-level) - (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]>>(debug(iprolog,\"~w:~w:~w~n\", [S,L,T]),format(\"~w:~w:~w~n\", [S,L,T]))), prolog_close_source(Stream))") - (lambda (o) - (with-current-buffer buffer - (with-silent-modifications + (when (buffer-modified-p) + (let ((buffer (current-buffer)) + (default-directory (or (iprolog-project--root) + default-directory)) + (beg (point-min)) + (end (point-max))) + (iprolog--ensure-top-level) + (setq iprolog-fontifying t) + (iprolog--request + (concat "colourise('" (buffer-file-name buffer) "', " (number-to-string beg) ", " (number-to-string end) ")") + (lambda () + (goto-char (point-min)) + (when (buffer-live-p buffer) + (let ((colors nil)) + (while (not (eobp)) + (setq colors (append colors (iprolog--parse-fontification-line (buffer-substring-no-properties (point) (line-end-position)) 1))) + (forward-line 1)) + (with-current-buffer buffer (save-mark-and-excursion - (font-lock-unfontify-buffer) - (dolist (line (string-lines o t)) - (when-let ((f (iprolog--parse-fontification-line line beg))) + (with-silent-modifications + (font-lock-unfontify-region beg (min end (point-max))) + (dolist (f colors) (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]>>(debug(iprolog,\"~w:~w:~w~n\", [S,L,T]),format(\"~w:~w:~w~n\", [S,L,T])), [])) -> at_end_of_stream(Stream), ! ; true)), 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))) + (fp (caddr f)) + (fv (cadddr f))) + (when fp + (unless (> fe (point-max)) + (put-text-property fs fe fp fv))))) + (font-lock-fontify-keywords-region beg (min end (point-max)) loudly)))))) + (with-current-buffer buffer + (setq iprolog-fontifying nil)))))) + t) +(defun iprolog-font-lock-ensure-function () + (while iprolog-fontifying + (accept-process-output))) ;;; fill-paragraph @@ -1056,4 +1156,11 @@ explanation about the argument CALLBACK." ;;; experiments +(defun iprolog-after-change-function (beg end pre) + "Used for `after-change-functions', which see about BEG, END and PRE." + (let ((default-directory (or (iprolog-project--root) + default-directory))) + (iprolog--ensure-top-level) + (iprolog--request (format "change('%s', %s, %s, %s)" (buffer-file-name) beg end pre)))) + ;;; iprolog.el ends here -- 2.39.5