Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Set background color for dispatch highlighting. Still problems with m…

…ultiple overlays
  • Loading branch information...
commit 2202885583ce3ffe59fca087dcf621dc979f21eb 1 parent 73b4660
@hannesm hannesm authored
Showing with 58 additions and 5 deletions.
  1. +58 −5 dylan-optimization-coloring.el
View
63 dylan-optimization-coloring.el
@@ -12,6 +12,43 @@
(defvar color-bogus-upgrade "Orange")
+(defface face-not-all-methods-known
+ `((t (:background "magenta")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-failed-to-select-where-all-known
+ `((t (:background "red")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-lambda-call
+ `((t (:background "lightskyblue")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-inlining
+ `((t (:background "dimgray")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-slot-accessor-fixed-offset
+ `((t (:background "forestgreen")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-eliminated
+ `((t (:background "pink")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-dynamic-extent
+ `((t (:background "DarkTurquoise")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-program-notes
+ `((t (:background "yellow")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+(defface face-bogus-upgrade
+ `((t (:background "orange")))
+ "Bla bla bla"
+ :group 'slime-mode-faces)
+
(defun find-dylan-library ()
(let ((lid-files (find-dylan-lid-files)))
(save-excursion
@@ -47,13 +84,29 @@
(goto-char 1) (forward-line (1- sl)) (forward-char sc)
(let ((start (point))
(overlay (slime-note-at-point)))
-; (set-mark (point))
(goto-char 1) (forward-line (1- el)) (forward-char ec)
-; (facemenu-set-background color))
(let ((end (point)))
- (if overlay
- (slime-merge-note-into-overlay overlay severity message)
- (slime-create-note-overlay "what?" start end :warning 'color)))))
+ (let ((over (make-overlay start end)))
+ (if (string= color "Magenta")
+ (overlay-put over 'face 'face-not-all-methods-known)
+ (if (string= color "Red")
+ (overlay-put over 'face 'face-failed-to-select-where-all-known)
+ (if (string= color "Blue")
+ (overlay-put over 'face 'face-lambda-call)
+ (if (string= color "ForestGreen")
+ (overlay-put over 'face 'face-slot-accessor-fixed-offset)
+ (if (string= color "Pink")
+ (overlay-put over 'face 'face-eliminated)
+ (if (string= color "DarkTurquoise")
+ (overlay-put over 'face 'face-dynamic-extent)
+ (if (string= color "Yellow")
+ (overlay-put over 'face 'face-program-notes)
+ (if (string= color "Orange")
+ (overlay-put over 'face 'face-bogus-upgrade)))))))))))))
+; (overlay-put over 'face color)))))
+; (if overlay
+; (slime-merge-note-into-overlay overlay severity message)
+; (slime-create-note-overlay "what?" start end :warning 'color)))))
; (set-mark (point))
; (message (concat "set mark at " (number-to-string (+ sl 1)) ":" (number-to-string sc) "-" (number-to-string (+ el 1)) ":" (number-to-string ec) ":" color)))
; (facemenu-set-foreground color))
Please sign in to comment.
Something went wrong with that request. Please try again.