[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