[sawfish: 1/2] Proper alist deletion in update-frame-font-color.



commit dab077a55d95367b11c87572113bd79b7acbec0b
Author: Timo Korvola <tkorvola iki fi>
Date:   Mon Sep 28 00:59:52 2009 +0300

    Proper alist deletion in update-frame-font-color.

 lisp/sawfish/wm/frames.jl |   21 ++++++++++++++++-----
 1 files changed, 16 insertions(+), 5 deletions(-)
---
diff --git a/lisp/sawfish/wm/frames.jl b/lisp/sawfish/wm/frames.jl
index 9c65c2e..77a3333 100644
--- a/lisp/sawfish/wm/frames.jl
+++ b/lisp/sawfish/wm/frames.jl
@@ -51,6 +51,7 @@
 	     add-frame-class
 	     frame-class-removed-p
 	     set-frame-part-value
+	     remove-frame-part-value
 	     def-frame-class
 	     define-frame-class
 	     update-frame-font-color))
@@ -167,11 +168,14 @@ that overrides settings set elsewhere.")
   (define (update-frame-font-color)
     (if use-custom-font-color
 	(mapc (lambda (fc)
-		(set-frame-part-value fc 'foreground (list frame-font-inactive-color frame-font-active-color) 't)) (list 'title 'tab))
-      (mapc (lambda (fc)
-	      (rplacd (assoc 'foreground (assoc fc override-frame-part-classes)) nil)
-	      (rplaca (assoc 'foreground (assoc fc override-frame-part-classes)) nil)) (list 'title 'tab)))
-    (mapc (lambda (x) (rebuild-frame x)) (managed-windows)))
+		(set-frame-part-value fc 'foreground
+                                      (list frame-font-inactive-color
+                                            frame-font-active-color)
+                                      t))
+              '(title 'tab))
+      (mapc (lambda (fc) (remove-frame-part-value fc 'foreground t))
+            '(title tab)))
+    (mapc rebuild-frame (managed-windows)))
 
   (defvar theme-update-interval 60
     "Number of seconds between checking if theme files have been modified.")
@@ -574,6 +578,13 @@ deciding which frame type to ask a theme to generate.")
 	(set var (cons (cons class (list (cons key value)))
 		       (symbol-value var))))))
 
+  (define (remove-frame-part-value class key #!optional override)
+    (let* ((fpcs (if override override-frame-part-classes frame-part-classes))
+           (item (assq class fpcs)))
+      (when item
+        (setcdr item (delete-if (lambda (it) (eq (car it) key))
+                                (cdr item))))))
+
   ;; (def-frame-class shade-button '((cursor . foo) ...)
   ;;   (bind-keys shade-button-keymap
   ;;     "Button1-Off" 'toggle-window-shaded))



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]