(setq-local comment-start "%")
(setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
(setq-local parens-require-spaces nil)
- ;; (add-hook 'flymake-diagnostic-functions #'iprolog--checker nil t)
+ (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)
(add-hook 'completion-at-point-functions #'iprolog--atom-completion-at-point-function nil t)
- (add-hook 'after-change-functions
- (lambda (b e l)
- (message "change %s %s %s in %s" b e l (current-buffer)))
- nil t)
;; (setq-local compile-command ...)
;; (setq-local electric-indent-chars ...)
;; (setq-local align-rules-alist ...)
;; (setq-local imenu-create-index-function ...)
- (setq jit-lock-chunk-size 262144)
+ (setq jit-lock-chunk-size 8192)
(setq-local font-lock-defaults
'(nil
t
"-g" "[library(pldoc/doc_man)]"
"-g" "[library(lynx/html_text)]"
"-g" "[library(diagnostics)]"
- "-g" (concat "thread_create((udp_socket(Socket), tcp_bind(Socket," (number-to-string port) "), tcp_setopt(Socket, sndbuf(65535)), repeat, (catch(udp_receive(Socket, Data, Peer, [as(term),encoding(utf8)]), Ball, (debug(iprolog, \"Caught ~q.\", [Ball]), fail)), debug(iprolog, \"Got ~p from ~q.\", [Data, Peer]), Data = (Id :- Goal) -> debug(iprolog, \"Executing goal ~w.\", [Goal]), catch(with_output_to(string(Output), ignore(Goal)), GBall, (debug(iprolog, \"Ball ~q thrown during goal execution.\", [GBall]), fail)), string_concat(Id, \" :- \", Prefix), string_concat(Prefix, Output, Reply0), (string_length(Reply0, Length), Length > 49152 -> debug(iprolog, \"detected large output (~w characters long).\", [Length]), sub_string(Reply0, 0, 49152, _, Reply) ; Reply = Reply0), udp_send(Socket, Reply, Peer, [encoding(utf8)]), debug(iprolog, \"Sending reply ~w.\", [Reply]) ; debug(iprolog, \"udp_receive failed.\", [])), fail), _, [])")
+ "-g" (concat "thread_create((udp_socket(Socket), tcp_bind(Socket," (number-to-string port) "), tcp_setopt(Socket, sndbuf(65535)), repeat, (catch(udp_receive(Socket, Data, Peer, [as(term),encoding(utf8)]), Ball, (debug(iprolog, \"Caught ~q.\", [Ball]), fail)), debug(iprolog, \"Got ~p from ~q.\", [Data, Peer]), Data = (Id :- Goal) -> debug(iprolog, \"Executing goal ~w.\", [Goal]), catch(with_output_to(string(Output), ignore(Goal)), GBall, (debug(iprolog, \"Ball ~q thrown during goal execution.\", [GBall]), fail)), string_concat(Id, \" :- \", Prefix), string_length(Output, Length), phrase(helper(Output, Length, 49152), Replies), forall(member(Reply0, Replies), (string_concat(Prefix, Reply0, Reply), udp_send(Socket, Reply, Peer, [encoding(utf8)]), debug(iprolog, \"Sending reply ~w.\", [Reply]))) ; debug(iprolog, \"udp_receive failed.\", [])), fail), _, [])")
"-t" "prolog")
(setq iprolog--helper-connection
(make-network-process
;;;; font lock
+(defgroup iprolog-faces nil
+ "Faces used to highlight Prolog code."
+ :group 'iprolog)
+
+(defvar iprolog-functor-face 'iprolog-functor-face
+ "Name of face used to highlight the functor in predicate indicators.")
+
+(defface iprolog-functor-face
+ '((default :inherit font-lock-function-name-face))
+ "Face used to highlight the functor in predicate indicators."
+ :group 'iprolog-faces)
+
+(defvar iprolog-arity-face 'iprolog-arity-face
+ "Name of face used to highlight the arity in predicate indicators.")
+
+(defface iprolog-arity-face
+ '((default :inherit font-lock-function-name-face))
+ "Face used to highlight the arity in predicate indicators."
+ :group 'iprolog-faces)
+
+(defvar iprolog-predicate-indicator-face 'iprolog-predicate-indicator-face
+ "Name of face used to highlight the '/' in predicate indicators.")
+
+(defface iprolog-predicate-indicator-face
+ '((default :inherit font-lock-function-name-face))
+ "Face used to highlight the '/' in predicate indicators."
+ :group 'iprolog-faces)
+
+(defvar iprolog-built-in-face 'iprolog-built-in-face
+ "Name of face used to highlight calls to built-ins in Prolog code.")
+
+(defface iprolog-built-in-face
+ '((default :inherit font-lock-keyword-face))
+ "Face used to highlight calls to built-ins in Prolog code."
+ :group 'iprolog-faces)
+
+(defvar iprolog-neck-face 'iprolog-neck-face
+ "Name of face used to highlight necks in Prolog code.")
+
+(defface iprolog-neck-face
+ '((default :inherit font-lock-preprocessor-face))
+ "Face used to highlight necks in Prolog code."
+ :group 'iprolog-faces)
+
+(defvar iprolog-goal-face 'iprolog-goal-face
+ "Name of face used to highlight body goals in Prolog code.")
+
+(defface iprolog-goal-face
+ '((default :inherit font-lock-function-name-face))
+ "Face used to highlight body goals in Prolog code."
+ :group 'iprolog-faces)
+
+(defvar iprolog-string-face 'iprolog-string-face
+ "Name of face used to highlight strings in Prolog code.")
+
+(defface iprolog-string-face
+ '((default :inherit font-lock-string-face))
+ "Face used to highlight strings in Prolog code."
+ :group 'iprolog-faces)
+
+(defvar iprolog-comment-face 'iprolog-comment-face
+ "Name of face used to highlight comments in Prolog code.")
+
+(defface iprolog-comment-face
+ '((default :inherit font-lock-comment-face))
+ "Face used to highlight comments in Prolog code."
+ :group 'iprolog-faces)
+
+(defvar iprolog-head-face 'iprolog-head-face
+ "Name of face used to highlight head functors in Prolog code.")
+
+(defface iprolog-head-face
+ '((default :inherit font-lock-builtin-face))
+ "Face used to highlight head functors in Prolog code."
+ :group 'iprolog-faces)
+(defvar iprolog-recursion-face 'iprolog-recursion-face
+ "Name of face used to highlight recursive calls in Prolog code.")
+
+(defface iprolog-recursion-face
+ '((default :inherit font-lock-builtin-face))
+ "Face used to highlight recursive calls in Prolog code."
+ :group 'iprolog-faces)
+
+(eval-when-compile
+ (defmacro iprolog-defface (name def doc)
+ "Define iprolog face FACE with doc DOC."
+ (declare
+ (indent defun)
+ (doc-string 3))
+ (let ((face (intern (concat "iprolog-" (symbol-name name) "-face"))))
+ `(progn
+ (defface ,face
+ '((default :inherit ,def))
+ ,(concat "Face used to highlight " (downcase doc))
+ :group 'iprolog-faces)
+ (defvar ,face ',face
+ ,(concat "Name of the face used to highlight " (downcase doc)))))))
+
+(iprolog-defface file button
+ "File specifiers.")
+
+(iprolog-defface identifier font-lock-type-face
+ "Identifiers.")
+
+(iprolog-defface module font-lock-type-face
+ "Module names.")
+
+(iprolog-defface singleton font-lock-warning-face
+ "Singletons.")
+
+(iprolog-defface fullstop font-lock-negation-char-face
+ "Fullstops.")
+
+(iprolog-defface nil font-lock-keyword-face
+ "The empty list.")
+
+(iprolog-defface variable font-lock-variable-name-face
+ "Variables.")
+
+(iprolog-defface control font-lock-keyword-face
+ "Control constructs.")
+
+(iprolog-defface atom font-lock-constant-face
+ "Atoms.")
+
+(iprolog-defface int font-lock-constant-face
+ "Integers.")
+
+(iprolog-defface error font-lock-warning-face
+ "Unspecified errors.")
+
+(iprolog-defface syntax-error error
+ "Syntax errors.")
+
(defun iprolog--parse-fontification-line (line start)
(when (string-match (rx
(seq line-start
((string= type "grammar_rule")
'(nil t))
((string= type "comment(structured)")
- (list font-lock-comment-face t))
+ (list iprolog-comment-face t))
((string= type "comment(block)")
- (list font-lock-comment-face t))
+ (list iprolog-comment-face t))
((string= type "string")
- (list font-lock-string-face t))
+ (list iprolog-string-face t))
((string= type "predicate_indicator")
- (list font-lock-function-name-face nil))
+ (list iprolog-predicate-indicator-face nil))
((string= type "arity")
- (list font-lock-function-name-face nil))
+ (list iprolog-arity-face nil))
+ ;; ((string-match (rx (seq line-start
+ ;; "predicate_indicator("
+ ;; (+ anychar)
+ ;; ")"))
+ ;; type nil t)
+ ;; (list font-lock-function-name-face nil))
+ ((string= type "functor")
+ (list iprolog-functor-face nil))
((string-match (rx (seq line-start
- "predicate_indicator("
+ "file("
(+ anychar)
")"))
type nil t)
- (list font-lock-function-name-face nil))
- ((string= type "functor")
- (list font-lock-function-name-face nil))
+ (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 font-lock-builtin-face nil))
+ (list iprolog-head-face nil))
((string-match (rx (seq line-start
"goal(recursion"
(+ anychar)
")"))
type nil t)
- (list font-lock-builtin-face nil))
+ (list iprolog-recursion-face nil))
((string-match (rx (seq line-start
"goal(built_in"
(+ anychar)
")"))
type nil t)
- (list font-lock-keyword-face nil))
+ (list iprolog-built-in-face nil))
((string-match (rx (seq line-start
"goal("
(+ anychar)
")"))
type nil t)
- (list font-lock-function-name-face nil))
+ (list iprolog-goal-face nil))
((string= type "comment(line)")
- (list font-lock-comment-face nil))
+ (list iprolog-comment-face nil))
((string-match (rx (seq line-start
"neck("
(+ anychar)
")"))
type nil t)
- (list font-lock-preprocessor-face nil))
+ (list iprolog-neck-face nil))
((string= type "var")
- (list font-lock-variable-name-face nil))
+ (list iprolog-variable-face nil))
((string= type "empty_list")
- (list font-lock-keyword-face nil))
+ (list iprolog-nil-face nil))
((string= type "fullstop")
- (list font-lock-keyword-face nil))
+ (list iprolog-fullstop-face nil))
((string= type "control")
- (list font-lock-keyword-face nil))
+ (list iprolog-control-face nil))
((string= type "atom")
- (list font-lock-constant-face nil))
+ (list iprolog-atom-face nil))
((string= type "int")
- (list font-lock-constant-face nil))
+ (list iprolog-int-face nil))
((string= type "error")
- (list font-lock-warning-face nil))
+ (list iprolog-error-face nil))
((string-match (rx (seq line-start
"syntax_error("
(+ anychar)
")"))
type nil t)
- (list font-lock-negation-char-face t))
+ (list iprolog-syntax-error-face t))
((string= type "singleton")
- (list font-lock-warning-face t))
+ (list iprolog-singleton-face t))
((string-match (rx (seq line-start
"module("
(+ anychar)
")"))
type nil t)
- (list font-lock-type-face nil))
+ (list iprolog-module-face nil))
((string= type "identifier")
- (list font-lock-constant-face nil))))))))
+ (list iprolog-identifier-face nil))))))))
(defvar-local iprolog-fontified nil)
-(defun iprolog-fontify-region (beg0 end0 _loudly)
- (let ((beg (if iprolog-fontified beg0 (point-min)))
- (end (if iprolog-fontified end0 (point-max)))
- (buffer (current-buffer))
- (default-directory (or (iprolog-project--root)
- default-directory)))
- (message "doin %s" (- end beg))
- (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 "\""
- tempfile
- "\"= Path, xref_source('"
- (buffer-file-name buffer)
- "'), setup_call_cleanup(prolog_open_source(Path, Stream), prolog_colourise_stream(Stream, Path, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T])), 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))))))
- (setq iprolog-fontified t))
- (delete-file tempfile))))
- `(jit-lock-bounds ,beg . ,end)))
+(defun iprolog-fontify-region (beg0 end0 loudly)
+ (let ((beg1 beg0)
+ (end1 end0))
+ (while
+ (let ((changed nil))
+ (when (and (> beg1 (point-min))
+ (get-text-property (1- beg1) 'font-lock-multiline))
+ (setq changed t)
+ (setq beg1 (or (previous-single-property-change
+ beg1 'font-lock-multiline)
+ (point-min))))
+ (let ((before-end (max (point-min) (1- end1)))
+ (new-end nil))
+ (when (get-text-property before-end 'font-lock-multiline)
+ (setq new-end (or (text-property-any before-end (point-max)
+ 'font-lock-multiline nil)
+ (point-max)))
+ (when (/= new-end end1)
+ (setq changed t)
+ (setq end1 new-end))))
+ changed))
+ (let ((beg (if iprolog-fontified beg1 (point-min)))
+ (end (if iprolog-fontified end1 (point-max)))
+ (buffer (current-buffer))
+ (default-directory (or (iprolog-project--root)
+ default-directory)))
+ (font-lock-unfontify-region beg end)
+ (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 "\""
+ tempfile
+ "\"= Path, xref_source('"
+ (buffer-file-name buffer)
+ "'), setup_call_cleanup(prolog_open_source(Path, Stream), prolog_colourise_stream(Stream, Path, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T])), 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))))))
+ (setq iprolog-fontified t))
+ (delete-file tempfile))))
+ (font-lock-fontify-keywords-region beg end loudly)
+ `(jit-lock-bounds ,beg . ,end))))
(defun iprolog-fontify-window ()
projects / dotfiles.git / commitdiff