From: Eshel Yaron Date: Thu, 11 Aug 2022 11:20:03 +0000 (+0300) Subject: Checkpoint X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3381f8e2160eedc3e4bbac39680b7b12907a83c1;p=dotfiles.git Checkpoint --- diff --git a/.emacs.d/esy.org b/.emacs.d/esy.org index 361a7ff..37858cc 100644 --- a/.emacs.d/esy.org +++ b/.emacs.d/esy.org @@ -388,6 +388,7 @@ For a list of available frame parameters, see [[info:elisp#Frame Parameters][eli "CANCELED(c@)")) org-babel-load-languages '((emacs-lisp . t) (shell . t) + (sql . t) (bnf . t) (prolog . t)) org-confirm-babel-evaluate nil @@ -1503,8 +1504,8 @@ include =emacs-lisp-mode= and =lisp-interaction-mode=. :END: #+begin_src emacs-lisp - (add-to-list 'auto-mode-alist '("\\.pl\\'" . prolog-mode)) - (add-to-list 'auto-mode-alist '("\\.plt\\'" . prolog-mode)) + (add-to-list 'auto-mode-alist '("\\.pl\\'" . iprolog-mode)) + (add-to-list 'auto-mode-alist '("\\.plt\\'" . iprolog-mode)) (defun esy/setup-prolog () "Setup `prolog-mode' and more Prolog-related settings." diff --git a/.emacs.d/lisp/iprolog.el b/.emacs.d/lisp/iprolog.el index 765f59d..ee4e37b 100644 --- a/.emacs.d/lisp/iprolog.el +++ b/.emacs.d/lisp/iprolog.el @@ -130,19 +130,15 @@ With numeric prefix argument N, move this many terms backward." (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 @@ -280,7 +276,7 @@ Also start a Prolog server listening on UDP port PORT." "-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 @@ -587,6 +583,140 @@ explanation about the argument CALLBACK." ;;;; 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 @@ -611,125 +741,156 @@ explanation about the argument CALLBACK." ((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 ()