From: Eshel Yaron Date: Wed, 31 Aug 2022 07:07:26 +0000 (+0300) Subject: Update Emacs config X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c4547c5df90985e15d0e9efde47876f431c8ee05;p=dotfiles.git Update Emacs config --- diff --git a/.emacs.d/esy.org b/.emacs.d/esy.org index d48954e..b6aa5ef 100644 --- a/.emacs.d/esy.org +++ b/.emacs.d/esy.org @@ -261,7 +261,7 @@ For a list of available frame parameters, see [[info:elisp#Frame Parameters][eli #+begin_src emacs-lisp (setq use-file-dialog nil use-dialog-box nil - initial-scratch-message "; Go.\n" + initial-scratch-message ";; Go.\n" ns-use-native-fullscreen t inhibit-startup-screen t ring-bell-function 'ignore) @@ -308,7 +308,7 @@ For a list of available frame parameters, see [[info:elisp#Frame Parameters][eli (require 'lin) (require 'which-key) (require 'whitespace-cleanup-mode) - (setq show-paren-context-when-offscreen t) + ;; (setq show-paren-context-when-offscreen t) (add-to-list 'lin-mode-hooks 'gnus-summary-mode-hook) (add-to-list 'lin-mode-hooks 'gnus-group-mode-hook) (add-to-list 'lin-mode-hooks 'gnus-server-mode-hook) @@ -320,6 +320,9 @@ For a list of available frame parameters, see [[info:elisp#Frame Parameters][eli (show-paren-mode)) (add-hook 'after-init-hook #'esy/setup-display) + (add-hook 'completion-list-mode-hook + (lambda () + (setq-local cursor-in-non-selected-windows nil))) #+end_src * Org-mode settings @@ -890,6 +893,16 @@ refiling directly into deeper headings as well. :CUSTOM_ID: applications :END: +** denote + +#+begin_src emacs-lisp + (require 'denote) + + (setq denote-directory (expand-file-name "~/Documents/notes/")) + (setq denote-dired-directories (list denote-directory)) + + (add-hook 'dired-mode-hook #'denote-dired-mode-in-directories) +#+end_src ** tramp :PROPERTIES: :CUSTOM_ID: tramp-optimization @@ -961,6 +974,8 @@ over ssh for remote connections. (setq elfeed-feeds '("https://lwn.net/headlines/rss" "https://reddit.com/r/prolog/.rss" + "https://maggieappleton.com/rss.xml" + "https://arcology.garden/updates.xml" "https://matt-rickard.com/rss" "https://www.haskellforall.com/feeds/posts/default" "https://cestlaz.github.io/rss.xml" @@ -1243,9 +1258,12 @@ does in the shell. (defun esy/setup-completion-at-point () "Setup `completion-at-point'." (require 'corfu) + (require 'corfu-indexed) (setq corfu-cycle t - corfu-margin-formatters '(esy/margin-formatter)) + corfu-margin-formatters '(esy/margin-formatter) + corfu-indexed-start 1) (global-corfu-mode) + (corfu-indexed-mode 1) (add-to-list 'completion-at-point-functions #'esy/dabbrev-capf) (add-to-list 'completion-at-point-functions #'esy/file-capf)) @@ -1267,6 +1285,7 @@ does in the shell. (setq read-extended-command-predicate #'command-completion-default-include-p completions-format 'one-column completion-auto-select nil + completions-detailed nil completion-styles '(orderless partial-completion basic) completion-show-help nil completions-header-format (propertize "%s candidates:\n" @@ -1505,8 +1524,8 @@ include =emacs-lisp-mode= and =lisp-interaction-mode=. :END: #+begin_src emacs-lisp - (add-to-list 'auto-mode-alist '("\\.pl\\'" . iprolog-mode)) - (add-to-list 'auto-mode-alist '("\\.plt\\'" . iprolog-mode)) + (add-to-list 'auto-mode-alist '("\\.pl\\'" . prolog-mode)) + (add-to-list 'auto-mode-alist '("\\.plt\\'" . prolog-mode)) (with-eval-after-load 'recentf (add-to-list 'recentf-exclude (rx (seq "/usr/local/lib/swipl/library/" (+ anychar) ".pl"))) @@ -1899,6 +1918,10 @@ Add the timezones of places of interest to the list of clocks shown by (repeat-mode) #+end_src +** Sibling files +#+begin_src emacs-lisp + (setq find-sibling-rules '(("\\([^/]+\\)\\.c\\'" "\\1.h"))) +#+end_src ** Predefined SQL connections :PROPERTIES: :CUSTOM_ID: predefined-sql-connections @@ -1909,26 +1932,34 @@ Add the timezones of places of interest to the list of clocks shown by #+begin_src emacs-lisp (with-eval-after-load 'sql - (setq sql-connection-alist - (let* ((a (auth-source-search :port 5432 - :max 2 - :require '(:user :port :secret :host))) - (d (car a)) - (p (cadr a))) - `((dev - (sql-product 'postgres) - (sql-user ,(plist-get d :user)) - (sql-port 5432) - (sql-password ,(funcall (plist-get d :secret))) - (sql-server ,(plist-get d :host)) - (sql-database "alerts")) - (prod - (sql-product 'postgres) - (sql-user ,(plist-get p :user)) - (sql-port 5432) - (sql-password ,(funcall (plist-get p :secret))) - (sql-server ,(plist-get p :host)) - (sql-database "alerts")))))) + (setq sql-connection-alist + (let* ((a (auth-source-search :port 5432 + :max 3 + :require '(:user :port :secret :host))) + (d (car a)) + (p (cadr a)) + (c (caddr a))) + `((dev + (sql-product 'postgres) + (sql-user ,(plist-get d :user)) + (sql-port 5432) + (sql-password ,(funcall (plist-get d :secret))) + (sql-server ,(plist-get d :host)) + (sql-database "alerts")) + (prod + (sql-product 'postgres) + (sql-user ,(plist-get p :user)) + (sql-port 5432) + (sql-password ,(funcall (plist-get p :secret))) + (sql-server ,(plist-get p :host)) + (sql-database "alerts")) + (cfg + (sql-product 'postgres) + (sql-user ,(plist-get c :user)) + (sql-port 5432) + (sql-password ,(funcall (plist-get c :secret))) + (sql-server ,(plist-get c :host)) + (sql-database "container_graph")))))) #+end_src * Elisp Footer diff --git a/.emacs.d/lisp/iprolog.el b/.emacs.d/lisp/iprolog.el deleted file mode 100644 index 412f466..0000000 --- a/.emacs.d/lisp/iprolog.el +++ /dev/null @@ -1,1494 +0,0 @@ -;;; iprolog.el --- Interactive Prolog mode -*- lexical-binding:t -*- - -;; Copyright (C) 2022 Eshel Yaron - -;; Authors: Eshel Yaron -;; Maintainer: Eshel Yaron -;; Keywords: prolog major mode - -;; This file is NOT part of GNU Emacs. - -;;; Package-Version: 0.1.0 -;;; Package-Requires: ((emacs "28")) - -;;; Commentary: - -;;; Code: - -(require 'project) -(require 'comint) -(require 'flymake) - -(defgroup iprolog nil - "Editing and running Prolog code." - :group 'prolog) - -(defcustom iprolog-program "swipl" - "The Prolog executable." - :package-version '((iprolog . "0.1.0")) - :type 'string - :risky t - :group 'iprolog) - -(defgroup iprolog-project nil - "Prolog projects." - :group 'iprolog) - -(defcustom iprolog-project-definition-file-name "pack.pl" - "File name for Prolog project definitions." - :package-version '((iprolog . "0.1.0")) - :type 'string - :group 'iprolog-project) - -(defcustom iprolog-enable-flymake t - "When Non-nil, enable integration with `flymake-mode'." - :package-version '((iprolog . "0.1.0")) - :type 'boolean - :group 'iprolog) - -(defcustom iprolog-enable-flymake t - "When Non-nil, enable integration with `eldoc'." - :package-version '((iprolog . "0.1.0")) - :type 'boolean - :group 'iprolog) - - -;; (defun iprolog-forward-term-2 (&optional arg _interactive) -;; "Backend for `forward-sexp', which see for the meaning of ARG." -;; (font-lock-ensure) -;; (iprolog-font-lock-ensure-function) -;; (let* ((point (ponit)) -;; (times0 (or arg 1)) -;; (dir (or (and (< 0 times0) 1) -1)) -;; (times (abs times0))) -;; (while (< 0 times) -;; (unless (or (= point (buffer-end dir)) -;; (get-text-property point (iprolog-goal-end-prop dir))) -;; (next-single-property-change point ) -;; (while (not (or (buffer-end dir) -;; (get-text-property (point) 'iprolog-end-of-goal) -;; (get-text-property (point) 'iprolog-beginning-of-goal))) -;; (forward-char dir))) -;; (if-let ((g (get-text-property (point) (iprolog-goal-end-prop (* -1 dir))))) -;; (while (not (or (buffer-end dir) -;; (equal g (get-text-property (point) (iprolog-goal-end-prop dir))))) -;; (forward-char dir)) -;; (backward-char dir) -;; (signal 'scan-error -;; (list "No next term" -;; (save-mark-and-excursion -;; (let ((k (get-text-property (point) (iprolog-goal-end-prop dir)))) -;; (while (not (or (buffer-end (* -1 dir)) -;; (equal k (get-text-property (point) (iprolog-goal-end-prop (* -1 dir)))))) -;; (backward-char dir))) -;; (point)) -;; (point)))) -;; (setq times (1- times))))) - -;; (defun iprolog-goal-end-prop (dir) -;; (if (< 0 dir) -;; 'iprolog-end-of-goal -;; 'iprolog-beginning-of-goal)) - -;; (defun iprolog-forward-term (&optional arg _interactive) -;; "Backend for `forward-sexp', which see for the meaning of ARG." -;; (font-lock-ensure) -;; (iprolog-font-lock-ensure-function) -;; (let ((times (or arg 1))) -;; (if (< times 0) -;; (iprolog-backward-term (- times)) -;; (while (< 0 times) -;; (unless (or (eobp) -;; (get-text-property (point) 'iprolog-beginning-of-goal)) -;; (forward-char) -;; (while (not (or (eobp) -;; (get-text-property (point) 'iprolog-end-of-goal) -;; (get-text-property (point) 'iprolog-beginning-of-goal))) -;; (forward-char))) -;; (if-let ((g (get-text-property (point) 'iprolog-beginning-of-goal))) -;; (while (not (or (eobp) -;; (equal g (get-text-property (point) 'iprolog-end-of-goal)))) -;; (forward-char)) -;; (backward-char) -;; (signal 'scan-error -;; (list "No next term" -;; (save-mark-and-excursion -;; (let ((k (get-text-property (point) 'iprolog-end-of-goal))) -;; (while (not (or (bobp) -;; (equal k (get-text-property (point) 'iprolog-beginning-of-goal)))) -;; (backward-char))) -;; (point)) -;; (point)))) -;; (setq times (1- times)))))) - -;; (defun iprolog-backward-term (times) -;; (while (< 0 times) -;; (unless (or (bobp) -;; (get-text-property (point) 'iprolog-end-of-goal)) -;; (backward-char) -;; (while (not (or (bobp) -;; (get-text-property (point) 'iprolog-end-of-goal) -;; (get-text-property (point) 'iprolog-beginning-of-goal))) -;; (backward-char))) -;; (if-let ((g (get-text-property (point) 'iprolog-end-of-goal))) -;; (while (not (or (bobp) -;; (equal g (get-text-property (point) 'iprolog-beginning-of-goal)))) -;; (backward-char)) -;; (signal 'scan-error -;; (list "No previous term" -;; (point) -;; (save-mark-and-excursion -;; (let ((k (get-text-property (point) 'iprolog-beginning-of-goal))) -;; (while (not (or (eobp) -;; (equal k (get-text-property (point) 'iprolog-end-of-goal)))) -;; (forward-char))) -;; (point))))) -;; (setq times (1- times)))) - -(defun iprolog-forward-term-new (&optional arg) - "Backend for \\[forward-sexp], which see for the meaning of ARG." - (font-lock-ensure) - (iprolog-font-lock-ensure-function) - (let ((times (or arg 1))) - (if (< times 0) - (iprolog-backward-term-new (- times)) - (let ((point (point))) - (dotimes (_ times) (setq point (iprolog-forward-term1 point))) - (when point - (goto-char point)))))) - -(defun iprolog-forward-term1 (point) - (if-let ((other-end (and (not (= point (point-max))) - (iprolog-beginning-of-thing point)))) - other-end - (let ((p (min (1+ point) (point-max)))) - (while (not (or (= p (point-max)) - (get-text-property p 'iprolog-term-end))) - (setq p (1+ p))) - (if-let ((end (and (not (= p (point-max))) - (iprolog-beginning-of-thing p)))) - end - (max point (1- p)))))) - -(defun iprolog-backward-term-new (&optional arg) - "Backend for \\[forward-sexp], which see for the meaning of ARG." - (let ((times (or arg 1))) - (let ((point (point))) - (dotimes (_ times) (setq point (iprolog-backward-term1 point))) - (when point - (goto-char point))))) - -(defun iprolog-backward-term1 (point) - (if-let ((other-end (and (not (= point (point-min))) - (iprolog-end-of-thing point)))) - other-end - (let ((p (max (1- point) (point-min)))) - (while (not (or (= p (point-min)) - (get-text-property p 'iprolog-term-end))) - (setq p (1- p))) - (if-let ((beg (and (not (= p (point-min))) - (iprolog-end-of-thing p)))) - beg - (min point p))))) - -(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)) - (let ((point (point))) - (dotimes (_ times) (setq point (iprolog-beginning-of-defun1 point))) - (when point - (goto-char point)))))) - -(defun iprolog-end-of-defun-function (&optional pom) - "Backend for `end-of-defun'." - (if-let ((point (or pom (point))) - (other-end (and (not (= point (point-min))) - (iprolog-beginning-of-defun-p point)))) - (goto-char other-end) - (let ((p (min (1+ point) (point-max)))) - (while (not (or (= p (point-max)) - (iprolog-end-of-defun-p p))) - (setq p (1+ p))) - (when (iprolog-end-of-defun-p p) - (goto-char p))))) - -(defun iprolog-beginning-of-next-defun (times) - (let ((point (point))) - (dotimes (_ times) (setq point (iprolog-beginning-of-next-defun1 point))) - (when point - (goto-char point)))) - -(defun iprolog-beginning-of-defun1 (point) - (if-let ((other-end (and (not (= point (point-min))) - (iprolog-end-of-defun-p point)))) - other-end - (let ((p (max (1- point) (point-min)))) - (while (not (or (= p (point-min)) - (iprolog-beginning-of-defun-p p))) - (setq p (1- p))) - (and (iprolog-beginning-of-defun-p p) p)))) - -(defun iprolog-beginning-of-next-defun1 (point) - (let ((p (+ point (or (and (iprolog-beginning-of-defun-p point) 1) 0)))) - (while (not (or (= p (point-max)) - (iprolog-beginning-of-defun-p p))) - (setq p (1+ p))) - (and (iprolog-beginning-of-defun-p p) p))) - -(defun iprolog-beginning-of-thing (point) - (cddar (seq-filter (lambda (e) (pcase e (`(beg ,_ . ,_) t))) (get-text-property point 'iprolog-term-end)))) - -(defun iprolog-end-of-thing (point) - (cddar (seq-filter (lambda (e) (pcase e (`(end ,_ . ,_) t))) (get-text-property point 'iprolog-term-end)))) - -(defun iprolog-end-of-defun-p (point) - (cddar (seq-filter (lambda (e) (pcase e (`(end top . ,_) t))) (get-text-property point 'iprolog-term-end)))) - -(defun iprolog-beginning-of-defun-p (point) - (cddar (seq-filter (lambda (e) (pcase e (`(beg top . ,_) t))) (get-text-property point 'iprolog-term-end)))) - - -;; (defun iprolog-text-property--find-beg-backward (property value) -;; (iprolog-text-property--find-end-backward property value) -;; (goto-char (or (previous-single-property-change (point) property) -;; (point-min)))) - -;; (defun iprolog-text-property--find-end-backward (property value) -;; (let ((go t)) -;; (while (and go (not (bobp))) -;; (backward-char) -;; (setq go (not (equal value -;; (get-text-property (point) property))))))) - - -;; (defun iprolog-text-property--find-beg-forward (property value) -;; (let ((go t)) -;; (while (and go (not (eobp))) -;; (forward-char) -;; (setq go (not (equal value -;; (get-text-property (point) property))))))) - -;; (defun iprolog-text-property--find-end-forward (property value) -;; (iprolog-text-property--find-beg-forward property value) -;; (goto-char (or (next-single-property-change (point) property) -;; (point-max)))) - - -;; (defun iprolog-beginning-of-term (&optional n) -;; "Move to the beginning of the current term. -;; If already at the beginning of a term, move to previous term. - -;; With numeric prefix argument N, move this many terms backward." -;; (interactive "p" nil iprolog-mode) -;; (let ((times (or n 1))) -;; (while (< 0 times) -;; (search-backward-regexp iprolog-beginning-of-term-regexp nil t) -;; (beginning-of-line) -;; (setq times (1- times))))) - -;; (defun iprolog-beginning-of-next-term () -;; "Move to the beginning of the next term." -;; (interactive nil iprolog-mode) -;; (goto-char (1+ (line-beginning-position))) -;; (or (search-forward-regexp iprolog-beginning-of-term-regexp nil t) -;; (goto-char (point-max))) -;; (beginning-of-line)) - -(defun iprolog--atom-at-point () - (when-let ((bounds (iprolog--atom-boundaries-at-point))) - (let ((start (car bounds)) - (end (cdr bounds))) - (buffer-substring-no-properties start end)))) - -(defun iprolog--atom-boundaries-at-point () - (let ((case-fold-search nil)) - (save-mark-and-excursion - (save-match-data - (unless (bobp) (backward-char)) - (while (looking-at "[[:alnum:]:_]" t) - (backward-char)) - (forward-char) - (when (looking-at "[[:lower:]]" t) - (let ((start (point))) - (while (looking-at "[[:alnum:]:_]" t) - (forward-char)) - (cons start (point)))))))) - -(defun iprolog-load-buffer () - "Save this buffer and load it into the current Prolog session." - (interactive nil iprolog-mode) - (iprolog--request (concat "load('" (buffer-file-name) "')"))) - -(eldoc-add-command 'complete-symbol 'corfu-complete 'completion-at-point) -;; (defun iprolog-eval-dwim (&optional insert) -;; (interactive "P" iprolog-mode) -;; (if (region-active-p) -;; (iprolog-eval-region (region-beginning) (region-end)) -;; (save-mark-and-excursion -;; (save-match-data -;; (iprolog-beginning-of-next-term) -;; (let ((end (point))) -;; (iprolog-beginning-of-term) -;; (iprolog-eval-region (point) end insert)))))) - -;; (defun iprolog-eval-region (beg end &optional insert) -;; (interactive "r\nP" iprolog-mode) -;; (let ((goal (buffer-substring-no-properties beg end)) -;; (default-directory (or (iprolog-project--root) -;; default-directory))) -;; (iprolog--ensure-top-level) -;; (iprolog--request-goal-output goal -;; (if insert -;; (lambda (o) -;; (message "iprolog: inserting output.") -;; (newline) -;; (insert o)) -;; (lambda (o) -;; (message "iprolog: received output %s" o)))))) - -(defvar-keymap iprolog-mode-map - :doc "Keymap for `iprolog-mode'." - ;; "M-a" #'iprolog-beginning-of-term - ;; "C-M-x" #'iprolog-eval-dwim - "C-c C-t" #'iprolog-top-level - "C-c C-l" #'iprolog-load-buffer) - -(defvar iprolog-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?\' "\"" table) - (modify-syntax-entry ?% "<" table) - (modify-syntax-entry ?\n ">" table) - (modify-syntax-entry ?* ". 23b" table) - (modify-syntax-entry ?/ ". 14" table) - table)) - -;;;###autoload -(define-derived-mode iprolog-mode prog-mode "iprolog" - "Major mode for editing Prolog code." - :group 'iprolog - (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) - (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 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-local fill-paragraph-function #'iprolog-fill-paragraph-function) - ;; (setq-local fill-forward-paragraph-function ...) - ;; (setq jit-lock-chunk-size 8192) - (setq-local forward-sexp-function #'iprolog-forward-term-new) - (setq-local beginning-of-defun-function #'iprolog-beginning-of-defun-function) - (setq-local end-of-defun-function #'iprolog-end-of-defun-function) -;; (run-with-idle-timer 0.3 t #'font-lock-fontify-buffer) - (setq-local font-lock-defaults - '(nil - t - nil - nil - (font-lock-support-mode) - (font-lock-fontify-region-function . iprolog-fontify-region) - (font-lock-extra-managed-props iprolog-beginning-of-term - iprolog-beginning-of-goal - iprolog-beginning-of-head - button - follow-link - category - button-data - mouse-face - keymap - action - help-echo - iprolog-term-end - iprolog-end-of-head - iprolog-end-of-goal - iprolog-end-of-term)))) - -;;;; project.el integration - -;;;###autoload -(defun project-try-iprolog (dir) - "Find a Prolog project definition file in DIR or a parent thereof. -Prolog project definition files are identified according to the -value of `iprolog-project-definition-file-name'." - (when dir - (unless (file-remote-p dir) - (if (file-exists-p (expand-file-name iprolog-project-definition-file-name - dir)) - (let ((root (string-replace (expand-file-name "~") "~" - (file-name-as-directory dir)))) - (cons 'iprolog-project root)) - (let ((parent (file-name-directory (directory-file-name dir)))) - (unless (string= parent dir) - (project-try-iprolog parent))))))) - -(defun iprolog--execute-to-string (goal) - "Call the Prolog goal GOAL and return its output as a string." - (shell-command-to-string (concat - iprolog-program - " -g " - (prin1-to-string (substring-no-properties goal)) - " -t halt"))) - -(cl-defmethod project-root ((project (head iprolog-project))) - "Return the root of the Prolog project PROJECT." - (cdr project)) - -(defun iprolog-project--root () - "Return the root directory of the current Prolog project." - (when-let ((proj (project-current))) - (project-root proj))) - -(defun iprolog-project--name () - "Return the name of the current Prolog project." - (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 (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 - -(defvar iprolog--top-level-buffers-alist nil - "Global mapping between directories and Prolog top-level buffers.") - -(defvar-local iprolog--helper-connection nil) - -(defvar iprolog--buffer-server-process nil) - -(defvar-local iprolog--server-process nil) - -(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) - -(defvar iprolog--last-helper-port 11111) - -(defvar iprolog--last-server-port 22222) - -(defvar iprolog--last-buffer-server-port 33333) - -(defvar-local iprolog--last-paren-id 0) - -(defun iprolog--ensure-buffer-server () - (unless (process-live-p iprolog--buffer-server-process) - (setq iprolog--buffer-server-process - (make-network-process - :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 - :buffer "iprolog-buffer-server-log" - :log - (lambda (server client message) - (with-current-buffer (process-buffer server) - (goto-char (point-max)) - (insert (format "%s %s %s" server client message)))) - :sentinel - (lambda (_proc _state)) - :filter - (lambda (proc output) - (save-excursion - (let* ((lines (string-lines output)) - (path (car lines) ) - (beg0 (string-to-number (cadr lines))) - (end0 (string-to-number (caddr lines))) - (buffer (or (find-buffer-visiting path) (find-file-noselect path t t )))) - (with-current-buffer buffer - (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--ensure-top-level-in-buffer buffer) - (setq iprolog--top-level-buffers-alist - (cons - (cons - default-directory - (iprolog--create-top-level)) - iprolog--top-level-buffers-alist)))) - -(defun iprolog--ensure-top-level-in-buffer (buffer) - "Make sure a Prolog top-level in running in BUFFER." - (if (buffer-live-p buffer) - (unless (process-live-p (get-buffer-process buffer)) - (iprolog--make-top-level buffer)) - (setf - (alist-get default-directory - iprolog--top-level-buffers-alist - nil 'remove #'string=) - (iprolog--create-top-level)))) - -(defun iprolog--top-level-buffer () - "Return the top-level buffer associated with `default-directory'." - (alist-get default-directory - iprolog--top-level-buffers-alist nil nil #'string=)) - -(defun iprolog--create-top-level () - (with-current-buffer (generate-new-buffer "*Prolog top-level*") - (iprolog-top-level-mode) - (iprolog--make-top-level (current-buffer)))) - -(defun iprolog--make-top-level (buffer) - (iprolog-top-level--start-in-buffer buffer - (setq iprolog--last-helper-port - (1+ iprolog--last-helper-port)) - (setq iprolog--last-server-port - (1+ iprolog--last-server-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, -SERVER-PORT." - (iprolog--ensure-buffer-server) - (make-comint-in-buffer - "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" - :local `[127 0 0 1 ,server-port] - :coding 'utf-8 - :server 5 - :buffer (generate-new-buffer "*iprolog-server-log*") - :log - (lambda (server client message) - (with-current-buffer (process-buffer server) - (goto-char (point-max)) - (insert (format "%s %s %s" server client message)))) - :sentinel - (lambda (proc state) - (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 - :service port - :type 'datagram - :filter - (lambda (_proc output) - (when-let ((cd (save-match-data - (string-match - (rx (seq (group (+ digit)) " :- " (group (* anychar)))) - output) - (let ((id (string-to-number (match-string 1 output))) - (data (match-string 2 output))) - (when-let ((cb (alist-get id (ring-elements (with-current-buffer buffer - iprolog--pending-requests))))) - (cons cb data)))))) - (funcall (car cd) (cdr cd)))))) - buffer) - -(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))) - (iprolog--ensure-top-level) - (with-current-buffer (iprolog--top-level-buffer) - (setq iprolog--last-request-id - (1+ iprolog--last-request-id)) - (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) - default-directory))) - (iprolog--ensure-top-level) - (let ((buffer (iprolog--top-level-buffer))) - (with-current-buffer buffer - (setq iprolog--sync-output nil) - (iprolog--request goal - (lambda (o) - (with-current-buffer buffer - (setq iprolog--sync-output o)))) - (while (null iprolog--sync-output) - (accept-process-output iprolog--helper-connection 10)) - iprolog--sync-output)))) - -(defun iprolog-top-level--on-exec () - "Setup the Prolog top-level process." - (when-let ((proc (get-buffer-process (current-buffer)))) - (set-process-sentinel proc (lambda (_ _) (comint-write-input-ring))) - (accept-process-output proc 10))) - -(defvar iprolog-top-level--fontifying nil) - -(defun iprolog-top-level--fontify-query (&optional buf loudly) - (let ((buffer (or buf (current-buffer)))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((beg (cdr comint-last-prompt)) - (end (point-max)) - (query (buffer-substring-no-properties (cdr comint-last-prompt) (point-max)))) - - (setq iprolog-top-level--fontifying t) - (iprolog--request - (concat "colourise(query, " (prin1-to-string query) ")") - (lambda () - (goto-char (point-min)) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (with-silent-modifications - (font-lock-unfontify-region beg (min end (point-max))) - (put-text-property (1- beg) (point-max) 'font-lock-face 'default))) - (while (not (eobp)) - (let ((colors (iprolog--parse-fontification-line (buffer-substring-no-properties (point) (line-end-position)) beg))) - (with-current-buffer buffer - (with-silent-modifications - (dolist (f colors) - (let ((fs (car f)) - (fe (cadr f)) - (fp (caddr f)) - (fv (cadddr f))) - (when fp - (unless (> fe (point-max)) - (if (equal fp 'iprolog-term-end) - (put-text-property fs fe fp (cons fv (get-text-property fs 'iprolog-term-end))) - (put-text-property fs fe fp fv))))))))) - (forward-line 1))) - (with-current-buffer buffer - (setq iprolog-top-level--fontifying nil))))))))) - -(defvar iprolog-top-level-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [remap self-insert-command] #'iprolog-top-level--self-insert-command) - (define-key map [remap comint-send-input] #'iprolog-top-level--maybe-send-input) - map)) - -(defun iprolog-top-level--maybe-send-input (&optional no-newline artificial) - "NO-NEWLINE, ARTIFICIAL." - (interactive) - (while iprolog-top-level--fontifying - (accept-process-output)) - (call-interactively - (if (and (save-mark-and-excursion - (goto-char (point-max)) - (skip-chars-backward " \n\t\v" (cdr comint-last-prompt)) - (= ?. (preceding-char))) - (not (save-mark-and-excursion - (goto-char (cdr comint-last-prompt)) - (text-property-search-forward 'font-lock-face - 'iprolog-syntax-error-face t)))) - #'comint-send-input - #'newline))) - - -(defun iprolog-top-level--self-insert-command () - "Insert the char in the buffer or pass it directly to the process." - (interactive) - (when-let ((pend (cdr comint-last-prompt))) - (let* ((pstart (car comint-last-prompt)) - (prompt (buffer-substring-no-properties pstart pend))) - (if (and (= (point) pend) - (not (string-empty-p prompt)) - (not (string= "?- " (substring prompt (- pend pstart 3) (- pend pstart)))) - (not (string= "| " prompt))) - (progn - (call-interactively #'self-insert-command) - (comint-send-input)) - (call-interactively #'self-insert-command))))) - -(defgroup iprolog-top-level nil - "Interactive Prolog top-level." - :group 'iprolog) - -(defcustom iprolog-top-level-input-ring-file-name ".iprolog_history" - "File name to use for persisting Prolog top-level history." - :type 'string - :group 'iprolog-top-level) - -(defcustom iprolog-top-level-display-buffer-action - '((display-buffer-reuse-window display-buffer-below-selected) - (window-height . 20)) - "The action used to display the top-level buffer." - :type '(cons (choice (function :tag "Display Function") - (repeat :tag "Display Functions" function)) - alist) - :package-version '(iprolog . "0.1.0") - :group 'iprolog-top-level) - -;;;###autoload -(defun iprolog-top-level () - "Switch to the current project's Prolog top-level." - (interactive) - (let ((default-directory (or (iprolog-project--root) - default-directory))) - (iprolog--ensure-top-level) - (display-buffer (iprolog--top-level-buffer) iprolog-top-level-display-buffer-action) - (switch-to-buffer-other-window (iprolog--top-level-buffer)) - (set-window-dedicated-p (selected-window) t) - (goto-char (point-max)))) - - -(defvar-local iprolog-top-level-timer nil "Buffer-local timer.") - - -;;;###autoload -(define-derived-mode iprolog-top-level-mode comint-mode "iprolog Top-level" - "Major mode for interacting with an inferior Prolog interpreter." - :group 'iprolog-top-level - (setq mode-line-process (list ":" - (or (iprolog-project--name) "") - ":" - (or (iprolog-project--version) "") - ":%s") - comint-prompt-regexp (rx (seq line-start "?- ")) - comint-input-ring-file-name (expand-file-name - iprolog-top-level-input-ring-file-name - default-directory) - comint-input-ignoredups t - comint-prompt-read-only t - comint-delimiter-argument-list '(?,) - comint-input-filter (lambda (s) (< 3 (length s)))) - (setq iprolog-top-level-timer (run-with-idle-timer 0.2 t #'iprolog-top-level--fontify-query (current-buffer))) - (add-hook 'kill-buffer-hook - (lambda () - (when (timerp iprolog-top-level-timer) - (cancel-timer iprolog-top-level-timer)))) - (setq-local comment-start "%") - (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) - (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 'eldoc-documentation-functions #'iprolog-predicate-modes-doc -10 t) - ) - - -;;;; flymake integration - -(defun iprolog--parse-diagnostic (line start) - (when (string-match (rx - (seq line-start - (group (or "warning" "error")) - ":" - (group (+ (not ":"))) - ":" - (group (+ digit)) - ":" - (group (+ digit)) - ": " - (group (+ anychar)))) - line) - (let* ((line-prefix (match-string 1 line)) - (path (match-string 2 line)) - (buff (find-buffer-visiting path)) - (beg (+ (string-to-number (match-string 3 line)) start)) - (end (+ beg (string-to-number (match-string 4 line)))) - (text (match-string 5 line)) - (type (if (string= "warning" line-prefix) :warning :error))) - (when buff - (flymake-make-diagnostic buff beg end type text))))) - -;;;###autoload -(defun iprolog--checker (report-fn &rest args) - "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 ((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) - - -;;;; eldoc integration - -;;;###autoload -(defun iprolog-predicate-modes-doc (callback &rest _ignored) - "Document predicate at point. -Intended for `eldoc-documentation-functions', which see for -explanation about the argument CALLBACK." - (when-let ((pi (iprolog-pi-at-point))) - (iprolog--request - (concat "document('" (buffer-file-name) "', " pi ")") - (lambda () - (funcall callback - (buffer-substring-no-properties (point-min) (point-max)) - :thing pi - :face font-lock-function-name-face))))) - -(defun iprolog-pi-at-point () - (cdadr (car (seq-filter (lambda (e) (pcase e (`(beg (goal . ,_) . ,_) t))) (get-text-property (or (and (iprolog-beginning-of-thing (point)) (point)) (iprolog-backward-term1 (point))) 'iprolog-term-end))))) -;;;; completions - - - -(defvar-local iprolog--current-atoms nil) - -(defun iprolog--current-atoms-completion-table (atom) - (let ((buffer (current-buffer)) - (goal (concat "atom_completion(" (prin1-to-string atom) ")"))) - (setq iprolog--current-atoms nil) - (iprolog--request goal - (lambda () - (let ((atoms (string-lines (buffer-substring-no-properties (point-min) (point-max)) t))) - (with-current-buffer buffer - (setq iprolog--current-atoms atoms))))) - (while (not iprolog--current-atoms) - (accept-process-output)) - iprolog--current-atoms)) - -(defun iprolog--atom-completion-at-point-function () - (let ((default-directory (or (iprolog-project--root) - default-directory))) - (iprolog--ensure-top-level) - (when-let ((bounds (iprolog--atom-boundaries-at-point))) - (let ((start (car bounds)) - (end (cdr bounds))) - (list start - end - (completion-table-with-cache #'iprolog--current-atoms-completion-table) - :exclusive 'no - :exit-function - (lambda (_ sts) - (when (eq sts 'finished) - (let ((opoint (point))) - (save-match-data - (with-silent-modifications - (skip-chars-backward "1234567890") - (when (= ?/ (preceding-char)) - (backward-char) - (let ((arity (string-to-number (buffer-substring-no-properties (1+ (point)) opoint)))) - (delete-region (point) opoint) - (when (< 0 arity) - (insert "(") - (dotimes (_ (1- arity)) - (insert "_, ")) - (insert "_)") - (goto-char (1- opoint)))))))) - ;; (let ((this-command nil) - ;; (last-command 'complete-symbol)) - ;; (eldoc-print-current-symbol-info)) - ))))))) - -(provide 'iprolog) - - -;;;; font lock - -(defgroup iprolog-faces nil - "Faces used to highlight Prolog code." - :group 'iprolog) - -(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 functor font-lock-function-name-face - "Functors.") - -(iprolog-defface arity font-lock-function-name-face - "Arities.") - -(iprolog-defface predicate-indicator font-lock-function-name-face - "Predicate indicators.") - -(iprolog-defface built-in font-lock-keyword-face - "Built in predicate calls.") - -(iprolog-defface neck font-lock-preprocessor-face - "Necks.") - -(iprolog-defface goal font-lock-function-name-face - "Unspecified predicate goals.") - -(iprolog-defface string font-lock-string-face - "Strings.") - -(iprolog-defface comment font-lock-comment-face - "Comments.") - -(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 no-option-name font-lock-warning-face - "Non-existent 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 qq-sep font-lock-type-face - "Quasi-quotation separators.") - -(iprolog-defface qq-open font-lock-type-face - "Quasi-quotation open sequences.") - -(iprolog-defface qq-close font-lock-type-face - "Quasi-quotation close sequences.") - -(iprolog-defface op-type font-lock-type-face - "Operator types.") - -(iprolog-defface dict-tag font-lock-constant-face - "Dict tags.") - -(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 instantiation-error font-lock-warning-face - "Instantiation 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 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 ext-quant font-lock-keyword-face - "Existential quantifiers.") - -(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 float font-lock-constant-face - "Floats.") - -(iprolog-defface codes font-lock-constant-face - "Codes.") - -(iprolog-defface error font-lock-warning-face - "Unspecified errors.") - -(iprolog-defface syntax-error error - "Syntax errors.") - -(iprolog-defface structured-comment font-lock-doc-face - "Structured comments.") - -(defun iprolog--parse-fontification-line (line start) - (when (string-match (rx - (seq line-start - (group (+ digit)) - ":" - (group (+ digit)) - ":" - (group (+ anychar)))) - line) - (let* ((beg (+ (string-to-number (match-string 1 line)) start)) - (end (+ beg (string-to-number (match-string 2 line)))) - (type (match-string 3 line))) - (cond - ((string-match (rx (seq line-start (or "clause" "term" "directive" "grammar_rule"))) type nil t) - `((,beg ,(1+ beg) iprolog-term-end (beg top . ,end)) - (,end ,(1+ end) iprolog-term-end (end top . ,beg)) - (,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_term(" (+ anychar) ")")) type nil t) - (let ((predicate (save-match-data - (string-match (rx (seq line-start "head_term(" (+ anychar) "," (group (+ anychar)) ")")) type) - (match-string 1 type)))) - `((,beg ,(1+ beg) iprolog-term-end (beg (head . ,predicate) . ,end)) - (,end ,(1+ end) iprolog-term-end (end (head . ,predicate) . ,beg))))) - ((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= type "parentheses") - `((,beg ,(1+ beg) iprolog-term-end (beg parentheses . ,end)) - (,end ,(1+ end) iprolog-term-end (end parentheses . ,beg)))) - ((string-match (rx (seq line-start "goal_term(" (+ anychar) ")")) type nil t) - (let ((predicate (save-match-data - (string-match (rx (seq line-start "goal_term(" (+ anychar) "," (group (+ anychar)) ")")) type) - (match-string 1 type)))) - `((,beg ,(1+ beg) iprolog-term-end (beg (goal . ,predicate) . ,end)) - (,end ,(1+ end) iprolog-term-end (end (goal . ,predicate) . ,beg))))) - ((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 "qq(open)") - `((,beg ,end font-lock-face ,iprolog-qq-sep-face))) - ((string= type "qq(close)") - `((,beg ,end font-lock-face ,iprolog-qq-sep-face))) - ((string= type "qq(sep)") - `((,beg ,end font-lock-face ,iprolog-qq-sep-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= type "no_option_name") - `((,beg ,end font-lock-face ,iprolog-no-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" - "list" - "qq" - "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) -(defvar-local iprolog-fontified nil) - -(defun iprolog-fontify-region (beg0 end0 loudly) - (when (or (not iprolog-fontified) (buffer-modified-p)) - (let ((buffer (current-buffer)) - (default-directory (or (iprolog-project--root) - default-directory)) - (beg (point-min)) - (end (point-max)) - ;; (beg (save-mark-and-excursion - ;; (goto-char beg0) - ;; (beginning-of-defun) - ;; (point))) - ;; (end (save-mark-and-excursion - ;; (goto-char end0) - ;; (end-of-defun) - ;; (end-of-defun) - ;; (point))) - ) - (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) - (with-current-buffer buffer - (with-silent-modifications - (font-lock-unfontify-region beg (min end (point-max))))) - (while (not (eobp)) - (let ((colors (iprolog--parse-fontification-line (buffer-substring-no-properties (point) (line-end-position)) beg))) - (with-current-buffer buffer - (with-silent-modifications - (dolist (f colors) - (let ((fs (car f)) - (fe (cadr f)) - (fp (caddr f)) - (fv (cadddr f))) - (when fp - (unless (> fe (point-max)) - (if (equal fp 'iprolog-term-end) - (put-text-property fs fe fp (cons fv (get-text-property fs 'iprolog-term-end))) - (put-text-property fs fe fp fv))))))))) - (forward-line 1)) - (with-current-buffer buffer - (with-silent-modifications - (save-mark-and-excursion - (font-lock-fontify-keywords-region beg (min end (point-max)) loudly))))) - (with-current-buffer buffer - (setq iprolog-fontifying nil)))))) - (setq iprolog-fontified t)) - -(defun iprolog-font-lock-ensure-function () - (while iprolog-fontifying - (accept-process-output))) - -;;; fill-paragraph - -(defun iprolog-fill-paragraph-function (&optional _justify) - (font-lock-ensure) - (iprolog-font-lock-ensure-function) - (let* ((buffer (current-buffer)) - (start (iprolog-beginning-of-defun1 (point))) - (end (min (iprolog-end-of-defun-function start) (point-max))) - (term (buffer-substring-no-properties start end))) - (iprolog--request (concat "portray('" (buffer-file-name) "'," (prin1-to-string term) ")") - (lambda () - (goto-char (point-max)) - (backward-delete-char 1) - (let ((output-buffer (current-buffer))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-mark-and-excursion - (save-restriction - (combine-after-change-calls - (narrow-to-region start (min (1+ end) (point-max))) - (replace-buffer-contents output-buffer)))))))))) - t) - - -;;; sync changes - -(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 diff --git a/.emacs.d/lisp/some-button.el b/.emacs.d/lisp/some-button.el index 60d55da..46f79d5 100644 --- a/.emacs.d/lisp/some-button.el +++ b/.emacs.d/lisp/some-button.el @@ -79,11 +79,8 @@ which to show preview for locations in BUFFER." (pulse-momentary-highlight-one-line)))) (unwind-protect (let ((completions-sort nil) - ; completion-extra-properties seems to get clobbered? - ;; (completion-extra-properties '(:annotate-function - ;; esy/annotate-button)) - (completion-annotate-function - (some-button--annotate-function collection buffer))) + (completion-extra-properties + (list :annotation-function (some-button--annotate-function collection buffer)))) (completing-read prompt collection nil t nil nil (caar collection))) (advice-remove #'next-completion 'next-completion@after-advice))) diff --git a/.zshenv b/.zshenv index 5c6d425..b159ab4 100644 --- a/.zshenv +++ b/.zshenv @@ -1 +1,3 @@ -export PATH=/Applications/Emacs.app/Contents/MacOS:/Applications/Emacs.app/Contents/MacOS/bin:/Users/eshelyaron/go/bin:$PATH +export PATH=/usr/local/opt/texinfo/bin:/Applications/Emacs.app/Contents/MacOS:/Applications/Emacs.app/Contents/MacOS/bin:/Users/eshelyaron/go/bin:$PATH +# export SWI_HOME_DIR=/usr/local/lib/swipl +# export C_INCLUDE_PATH=/usr/local/lib/swipl/include:/Applications/Emacs.app/Contents/Resources/include:$C_INCLUDE_PATH