"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")
(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))
(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)
"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)
(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 ...)
;; (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
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
(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)
(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
(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)))
(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
(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"
(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
(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)))
(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)
(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))))
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)
(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
(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.")
(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.")
(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.")
(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.")
(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.")
(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
;;; 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
projects / dotfiles.git / commitdiff