Hello, I wanted to use StumpWM, but was turned off by the lack of
user-defined colors, since I want Zenburn everywhere. This patch adds
support for user-defined colors. In the variable *colors*, the custom
colors are represented as hex, similar to Emacs' colors: "#xxxxxx".
Here is my *colors*:
(defparameter *colors* (list "#8f8f8f" ;; dark grey
"#cc9393" ;; zenburn red
"#7f9f7f" ;; zenburn green
"#f0dfaf" ;; tan
"#8cd0d3" ;; blue
"#dc8cc3" ;; magenta
"#93e0e3" ;; cyan
"#dcdccc" ;; white
"#dfaf8f" ;; orange
))
For all other custom color needs, the patch relies on type-checking:
strings are looked up, while anything else is used as-is. Therefore, to
use custom colors, use something along the lines of the following:
(set-fg-color (make-color-hex "#dcdccc"))
make-color-hex takes a hexadecimal description string, and returns the
XColor that it represents.
--
Andy Knapp
diff -rau -x '.git*' stumpwm/color.lisp a/color.lisp
+++ stumpwm/color.lisp 2011-07-16 17:37:13.311664657 -0700
--- a/color.lisp 2011-07-16 17:50:51.531173860 -0700
@@ -69,6 +69,18 @@
(defun lookup-color (screen color)
(xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color))
+(defun make-color-hex (hex)
+ "Converts a hexadecimal representation of a color to a decimal from [0,1)."
+ (labels ((convert (x)
+ (/ (read-from-string (concat "#x" x)) 256.0)))
+ (assert (and (eql (elt hex 0) #\#) (= (length hex) 7)))
+ (let ((red (subseq hex 1 3))
+ (green (subseq hex 3 5))
+ (blue (subseq hex 5 7)))
+ (xlib:make-color :red (funcall convert red)
+ :green (funcall convert green)
+ :blue (funcall convert blue)))))
+
;; Normal colors are dimmed and bright colors are intensified in order
;; to more closely resemble the VGA pallet.
(defun update-color-map (screen)
@@ -76,15 +88,19 @@
(let ((scm (xlib:screen-default-colormap (screen-number screen))))
(labels ((map-colors (amt)
(loop for c in *colors*
- as color = (xlib:lookup-color scm c)
- do (adjust-color color amt)
- collect (xlib:alloc-color scm color))))
- (setf (screen-color-map-normal screen) (apply #'vector (map-colors -0.25))
+ as color = (handler-case (xlib:lookup-color scm c)
+ (xlib:name-error (ne)
+ (make-color-hex c)))
+ do (adjust-color color amt)
+ collect (xlib:alloc-color scm color))))
+ (setf (screen-color-map-normal screen) (apply #'vector (map-colors 0.0))
(screen-color-map-bright screen) (apply #'vector (map-colors 0.25))))))
(defun update-screen-color-context (screen)
(let* ((cc (screen-message-cc screen))
- (bright (lookup-color screen *text-color*)))
+ (bright (if (stringp *text-color*)
+ (lookup-color screen *text-color*)
+ *text-color*)))
(setf
(ccontext-default-fg cc) (screen-fg-color screen)
(ccontext-default-bg cc) (screen-bg-color screen))
diff -rau -x '.git*' stumpwm/contrib/wifi.lisp a/contrib/wifi.lisp
+++ stumpwm/contrib/wifi.lisp 2011-07-16 17:37:13.314998003 -0700
--- a/contrib/wifi.lisp 2011-07-16 17:33:40.924260233 -0700
@@ -43,7 +43,7 @@
#:*wireless-device*))
(in-package :stumpwm.contrib.wifi)
-(defvar *iwconfig-path* "/sbin/iwconfig"
+(defvar *iwconfig-path* (run-shell-command "which iwconfig" t)
"Location if iwconfig, defaults to /sbin/iwconfig.")
(defvar *wireless-device* nil
diff -rau -x '.git*' stumpwm/mode-line.lisp a/mode-line.lisp
+++ stumpwm/mode-line.lisp 2011-07-16 17:37:13.324998038 -0700
--- a/mode-line.lisp 2011-07-16 17:33:40.924260233 -0700
@@ -358,8 +358,10 @@
(defun update-mode-line-color-context (ml)
(let* ((cc (mode-line-cc ml))
(screen (mode-line-screen ml))
- (bright (lookup-color screen *mode-line-foreground-color*)))
- (adjust-color bright 0.25)
+ (bright (if (stringp *mode-line-foreground-color*)
+ (lookup-color screen *mode-line-foreground-color*)
+ *mode-line-foreground-color*)))
+ ;; (adjust-color bright 0.25)
(setf (ccontext-default-bright cc) (alloc-color screen bright))))
(defun make-head-mode-line (screen head format)
_______________________________________________
Stumpwm-devel mailing list
Stumpwm-devel@nongnu.org
https://lists.nongnu.org/mailman/listinfo/stumpwm-devel
