[slime-devel] Custom and local keywords
David Vázquez
davazp at gmail.com
Thu Dec 8 16:59:14 UTC 2011
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 at 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)
More information about the slime-devel
mailing list