I have written a little patch for `slime-fontifying-fu.el' which adds support for custom keywords:
(setq slime-custom-keywords '("until" "once-only"))
and for file local keywords:
;;; Local variables: ;;; slime-local-keywords: ("ucond") ;;; End:
Please, modify it as you need and consider to apply it if you consider convenient. Thanks you.
index 20c78d5..f99ef43 100644 --- a/contrib/slime-fontifying-fu.el +++ b/contrib/slime-fontifying-fu.el @@ -1,4 +1,3 @@ - (define-slime-contrib slime-fontifying-fu "Additional fontification tweaks: Fontify WITH-FOO, DO-FOO, DEFINE-FOO like standard macros. @@ -6,24 +5,59 @@ Fontify CHECK-FOO like CHECK-TYPE." (:authors "Tobias C. Rittweiler tcr@freebits.de") (:license "GPL") (:on-load - (font-lock-add-keywords - 'lisp-mode slime-additional-font-lock-keywords) + (font-lock-add-keywords 'lisp-mode + slime-additional-font-lock-keywords) + (slime-add-custom-keyword) + (add-hook 'hack-local-variables-hook 'slime-hack-local-variables) (when slime-highlight-suppressed-forms (slime-activate-font-lock-magic))) (:on-unload ;; FIXME: remove `slime-search-suppressed-forms', and remove the ;; extend-region hook. - (font-lock-remove-keywords - 'lisp-mode slime-additional-font-lock-keywords))) + ;; FIXME: remove `slime-custom-keywords'. + (font-lock-remove-keywords + 'lisp-mode slime-additional-font-lock-keywords) + (remove-hook 'hack-local-variables-hook 'slime-hack-local-variables))) +
;;; Fontify WITH-FOO, DO-FOO, and DEFINE-FOO like standard macros. ;;; Fontify CHECK-FOO like CHECK-TYPE. (defvar slime-additional-font-lock-keywords - '(("(\(\(\s_\|\w\)*:\(define-\|do-\|with-\|without-\)\(\s_\|\w\)*\)" 1 font-lock-keyword-face) + '(("(\(\(\s_\|\w\)*:\(define-\|do-\|with-\|without-\)\(\s_\|\w\)*\)" 1 font-lock-keyword-face) ("(\(\(define-\|do-\|with-\)\(\s_\|\w\)*\)" 1 font-lock-keyword-face) ("(\(check-\(\s_\|\w\)*\)" 1 font-lock-warning-face) ("(\(assert-\(\s_\|\w\)*\)" 1 font-lock-warning-face)))
+(defvar slime-custom-keywords nil + "A list of extra keywords to highlight in the current +buffer. Each element is a string or a list (KEYWORD FACE) where +KEYWORD is string to highlight using FACE.") + +(defvar slime-local-keywords nil + "A list of keywords to highlight in the current buffer. Each +element is a string or a list (KEYWORD FACE) where KEYWORD is +string to highlight using FACE.") +(make-local-variable 'slime-local-keywords) + +(defun slime-keyword-spec (spec) + (let (keyword face) + (etypecase spec + (string + (setq keyword spec) + (setq face 'font-lock-keyword-face)) + (list + (setq keyword (car spec)) + (setq face (cadr spec)))) + (let ((regex (concat "(\(" (regexp-quote keyword) "\)\W"))) + (list regex 1 face)))) + +(defun slime-add-custom-keyword () + (let ((custom-keywords (mapcar 'slime-keyword-spec slime-custom-keywords))) + (font-lock-add-keywords 'lisp-mode custom-keywords))) + +(defun slime-hack-local-variables () + (let ((local-keywords (mapcar 'slime-keyword-spec slime-local-keywords))) + (font-lock-add-keywords nil local-keywords)))
;;;; Specially fontify forms suppressed by a reader conditional.
@@ -79,18 +113,18 @@ Fontify CHECK-FOO like CHECK-TYPE." (condition-case condition (setq result (slime-search-suppressed-forms-internal limit)) (end-of-file ; e.g. #+( - (setq result nil)) + (setq result nil)) ;; We found a reader conditional we couldn't process for ;; some reason; however, there may still be other reader ;; conditionals before `limit'. (invalid-read-syntax ; e.g. #+#.foo (setq result 'retry)) (scan-error ; e.g. #+nil (foo ... - (setq result 'retry)) + (setq result 'retry)) (slime-incorrect-feature-expression ; e.g. #+(not foo bar) (setq result 'retry)) (slime-unknown-feature-expression ; e.g. #+(foo) - (setq result 'retry)) + (setq result 'retry)) (error (setq result nil) (slime-display-warning @@ -109,13 +143,13 @@ position, or nil." ;;; conditional is at the same nesting level. (condition-case nil (let* ((orig-pt (point))) - (when-let (reader-conditional-pt + (when-let (reader-conditional-pt (search-backward-regexp slime-reader-conditionals-regexp ;; We restrict the search to the ;; beginning of the /previous/ defun. (save-excursion (beginning-of-defun) (point)) t)) - (let* ((parser-state + (let* ((parser-state (parse-partial-sexp (progn (goto-char (+ reader-conditional-pt 2)) (forward-sexp) ; skip feature expr. (point)) @@ -168,7 +202,7 @@ position, or nil." (let ((depth (nth 0 state))) (when (plusp depth) (ignore-errors (up-list (- depth)))) ; ignore unbalanced parentheses - (when-let (upper-pt (nth 1 state)) + (when-let (upper-pt (nth 1 state)) (goto-char upper-pt) (while (when-let (upper-pt (nth 1 (slime-current-parser-state))) (goto-char upper-pt)))))))) @@ -185,7 +219,7 @@ position, or nil." (t pt)))) (goto-char end) (while (search-backward-regexp slime-reader-conditionals-regexp beg t) - (setq end (max end (save-excursion + (setq end (max end (save-excursion (ignore-errors (slime-forward-reader-conditional)) (point))))) (values (or (/= beg orig-beg) (/= end orig-end)) beg end))) @@ -203,12 +237,12 @@ position, or nil." 'lisp-mode `((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t)))
- (add-hook 'lisp-mode-hook - #'(lambda () + (add-hook 'lisp-mode-hook + #'(lambda () (add-hook 'font-lock-extend-region-functions 'slime-extend-region-for-font-lock t t)))))
-(let ((byte-compile-warnings '())) +(let ((byte-compile-warnings '())) (mapc #'byte-compile '(slime-extend-region-for-font-lock slime-compute-region-for-font-lock @@ -333,11 +367,11 @@ position, or nil." 'slime-reader-conditional-face (get-text-property (point) 'face)))))
-(defun* slime-initialize-lisp-buffer-for-test-suite +(defun* slime-initialize-lisp-buffer-for-test-suite (&key (font-lock-magic t) (autodoc t)) (let ((hook lisp-mode-hook)) (unwind-protect - (progn + (progn (set (make-local-variable 'slime-highlight-suppressed-forms) font-lock-magic) (setq lisp-mode-hook nil)