diff --git a/extensions/lisp-mode/grammar.lisp b/extensions/lisp-mode/grammar.lisp index 36303e1b7..25ad11427 100644 --- a/extensions/lisp-mode/grammar.lisp +++ b/extensions/lisp-mode/grammar.lisp @@ -75,153 +75,155 @@ (:greedy-repetition 1 nil :whitespace-char-class) :whitespace-char-class :end-anchor #\( #\)))) -(defun make-tmlanguage-lisp () +(defun make-tmlanguage-lisp (&key extra-patterns) (let ((patterns (apply #'make-tm-patterns (remove-if #'null - (list - (make-tm-region - `(:sequence ";") - "$" - :name 'syntax-comment-attribute) - (make-tm-region - `(:sequence "|") - `(:sequence "|")) - (make-tm-region - `(:sequence "\"") - `(:sequence "\"") - :name 'syntax-string-attribute - :patterns (make-tm-patterns - (make-tm-match "\\\\."))) - (make-tm-region - `(:sequence "#|") - `(:sequence "|#") - :name 'syntax-comment-attribute) - (make-tm-match - "\\\\.") - (make-tm-match - `(:sequence - "(" - (:sequence + (append + extra-patterns + (list + (make-tm-region + `(:sequence ";") + "$" + :name 'syntax-comment-attribute) + (make-tm-region + `(:sequence "|") + `(:sequence "|")) + (make-tm-region + `(:sequence "\"") + `(:sequence "\"") + :name 'syntax-string-attribute + :patterns (make-tm-patterns + (make-tm-match "\\\\."))) + (make-tm-region + `(:sequence "#|") + `(:sequence "|#") + :name 'syntax-comment-attribute) + (make-tm-match + "\\\\.") + (make-tm-match + `(:sequence + "(" + (:sequence + ,(wrap-symbol-names + "defun" "defclass" "defgeneric" "defsetf" "defmacro" "defmethod" + "define-method-combination" "define-condition" + "define-setf-expander" "define-compiler-macro" + "define-modify-macro")) + (:greedy-repetition 0 1 (:register symbol))) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-function-name-attribute))) + (make-tm-match + `(:sequence + "(" ,(wrap-symbol-names "defun" "defmethod") + ,(ppcre:parse-string "\\s*\\(") + ,(ppcre:parse-string "((?i:setf))\\s+") + (:greedy-repetition 0 1 (:register symbol))) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-function-name-attribute) + (make-tm-name 'syntax-function-name-attribute))) + (make-tm-match + `(:sequence + "(" + (:group :case-insensitive-p + (:register (:sequence "define-" symbol))) + (:alternation (:greedy-repetition 1 nil :whitespace-char-class) + :end-anchor) + (:greedy-repetition 0 1 (:register symbol))) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-function-name-attribute))) + (make-tm-match + `(:sequence + "(" + (:group :case-insensitive-p + (:register (:sequence "def" symbol))) + (:alternation (:greedy-repetition 1 nil :whitespace-char-class) + :end-anchor) + (:greedy-repetition 0 1 (:register symbol))) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-function-name-attribute))) + (make-tm-match + `(:sequence + "(" ,(wrap-symbol-names - "defun" "defclass" "defgeneric" "defsetf" "defmacro" "defmethod" - "define-method-combination" "define-condition" - "define-setf-expander" "define-compiler-macro" - "define-modify-macro")) - (:greedy-repetition 0 1 (:register symbol))) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-function-name-attribute))) - (make-tm-match - `(:sequence - "(" ,(wrap-symbol-names "defun" "defmethod") - ,(ppcre:parse-string "\\s*\\(") - ,(ppcre:parse-string "((?i:setf))\\s+") - (:greedy-repetition 0 1 (:register symbol))) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-function-name-attribute) - (make-tm-name 'syntax-function-name-attribute))) - (make-tm-match - `(:sequence - "(" - (:group :case-insensitive-p - (:register (:sequence "define-" symbol))) - (:alternation (:greedy-repetition 1 nil :whitespace-char-class) - :end-anchor) - (:greedy-repetition 0 1 (:register symbol))) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-function-name-attribute))) - (make-tm-match - `(:sequence - "(" - (:group :case-insensitive-p - (:register (:sequence "def" symbol))) - (:alternation (:greedy-repetition 1 nil :whitespace-char-class) - :end-anchor) - (:greedy-repetition 0 1 (:register symbol))) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-function-name-attribute))) - (make-tm-match - `(:sequence - "(" - ,(wrap-symbol-names - "defvar" "defparameter" "defconstant" - "define-symbol-macro") - (:greedy-repetition 0 1 (:register symbol))) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-variable-attribute))) - (make-tm-match - `(:sequence - "(" - ,(wrap-symbol-names - "deftype" "defpackage" "defstruct" "uiop:define-package") - (:greedy-repetition 0 1 (:register symbol))) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-type-attribute))) - (make-tm-match - `(:sequence - "(" ,(wrap-symbol-names "defstruct") - ,(ppcre:parse-string "\\s*\\(") - (:register symbol)) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute) - (make-tm-name 'syntax-type-attribute))) - (make-tm-match - `(:sequence - "(" - ,(wrap-symbol-names - "cond" "if" "let" "let*" "progn" "prog1" - "prog2" "lambda" "unwind-protect" - "when" "unless" "with-output-to-string" - "ignore-errors" "dotimes" "dolist" "declare" - "block" "break" "case" "ccase" "compiler-let" "ctypecase" - "declaim" "destructuring-bind" "do" "do*" - "ecase" "etypecase" "eval-when" "flet" "flet*" - "go" "handler-case" "handler-bind" "in-package" - "labels" "letf" "locally" "loop" - "macrolet" "multiple-value-bind" "multiple-value-prog1" - "proclaim" "prog" "prog*" "progv" - "restart-case" "restart-bind" "return" "return-from" - "setf" "setq" "symbol-macrolet" "tagbody" "the" "typecase" - "with-accessors" "with-compilation-unit" - "with-condition-restarts" "with-hash-table-iterator" - "with-input-from-string" "with-open-file" - "with-open-stream" "with-package-iterator" - "with-simple-restart" "with-slots" "with-standard-io-syntax")) - :captures (vector nil - (make-tm-name 'syntax-keyword-attribute))) - (make-tm-match - `(:sequence - "(" ,(wrap-symbol-names "warn" "error" "signal" "abort" "cerror")) - :captures (vector nil (make-tm-name 'syntax-warning-attribute))) - (make-tm-match - `(:sequence - symbol-boundary-begin - ":" symbol - symbol-boundary-end) - :name 'syntax-builtin-attribute) - (make-tm-match - `(:sequence - (:positive-lookbehind "#") - ":" - symbol - symbol-boundary-end) - :name 'syntax-builtin-attribute) - (make-tm-match - `(:sequence - symbol-boundary-begin - "&" symbol - symbol-boundary-end) - :name 'syntax-constant-attribute) - (make-tm-match - "#[+-]" - :name 'syntax-comment-attribute - :move-action (lambda (cur-point) - (ignore-errors - (skip-feature cur-point))))))))) + "defvar" "defparameter" "defconstant" + "define-symbol-macro") + (:greedy-repetition 0 1 (:register symbol))) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-variable-attribute))) + (make-tm-match + `(:sequence + "(" + ,(wrap-symbol-names + "deftype" "defpackage" "defstruct" "uiop:define-package") + (:greedy-repetition 0 1 (:register symbol))) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-type-attribute))) + (make-tm-match + `(:sequence + "(" ,(wrap-symbol-names "defstruct") + ,(ppcre:parse-string "\\s*\\(") + (:register symbol)) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute) + (make-tm-name 'syntax-type-attribute))) + (make-tm-match + `(:sequence + "(" + ,(wrap-symbol-names + "cond" "if" "let" "let*" "progn" "prog1" + "prog2" "lambda" "unwind-protect" + "when" "unless" "with-output-to-string" + "ignore-errors" "dotimes" "dolist" "declare" + "block" "break" "case" "ccase" "compiler-let" "ctypecase" + "declaim" "destructuring-bind" "do" "do*" + "ecase" "etypecase" "eval-when" "flet" "flet*" + "go" "handler-case" "handler-bind" "in-package" + "labels" "letf" "locally" "loop" + "macrolet" "multiple-value-bind" "multiple-value-prog1" + "proclaim" "prog" "prog*" "progv" + "restart-case" "restart-bind" "return" "return-from" + "setf" "setq" "symbol-macrolet" "tagbody" "the" "typecase" + "with-accessors" "with-compilation-unit" + "with-condition-restarts" "with-hash-table-iterator" + "with-input-from-string" "with-open-file" + "with-open-stream" "with-package-iterator" + "with-simple-restart" "with-slots" "with-standard-io-syntax")) + :captures (vector nil + (make-tm-name 'syntax-keyword-attribute))) + (make-tm-match + `(:sequence + "(" ,(wrap-symbol-names "warn" "error" "signal" "abort" "cerror")) + :captures (vector nil (make-tm-name 'syntax-warning-attribute))) + (make-tm-match + `(:sequence + symbol-boundary-begin + ":" symbol + symbol-boundary-end) + :name 'syntax-builtin-attribute) + (make-tm-match + `(:sequence + (:positive-lookbehind "#") + ":" + symbol + symbol-boundary-end) + :name 'syntax-builtin-attribute) + (make-tm-match + `(:sequence + symbol-boundary-begin + "&" symbol + symbol-boundary-end) + :name 'syntax-constant-attribute) + (make-tm-match + "#[+-]" + :name 'syntax-comment-attribute + :move-action (lambda (cur-point) + (ignore-errors + (skip-feature cur-point)))))))))) (make-tmlanguage :patterns patterns))) diff --git a/extensions/lisp-mode/repl.lisp b/extensions/lisp-mode/repl.lisp index 9f3e56d50..4f347f065 100644 --- a/extensions/lisp-mode/repl.lisp +++ b/extensions/lisp-mode/repl.lisp @@ -6,10 +6,22 @@ (define-attribute repl-result-attribute (t :foreground :base06 :bold t)) +(define-attribute warning-attribute + (:dark :foreground "yellow") + (:light :foreground "orange")) + +(defvar *repl-syntax-table* (lem/buffer/syntax-table::copy-syntax-table lem-lisp-syntax:*syntax-table*)) +(set-syntax-parser *repl-syntax-table* + (make-tmlanguage-lisp :extra-patterns + (list (make-tm-region + "^WARNING:" + "$" + :name 'warning-attribute)))) + (define-major-mode lisp-repl-mode lisp-mode (:name "REPL" :keymap *lisp-repl-mode-keymap* - :syntax-table lem-lisp-syntax:*syntax-table* + :syntax-table *repl-syntax-table* :mode-hook *lisp-repl-mode-hook*) (cond ((eq (repl-buffer) (current-buffer)) @@ -490,7 +502,9 @@ (attribute (setf current-attribute token)) (string - (insert-string point token :sticky-attribute current-attribute)))))) + (if current-attribute + (insert-string point token :sticky-attribute current-attribute) + (insert-string point token))))))) (define-command backward-prompt () () (when (equal (current-buffer) (repl-buffer))