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