From b508c40f18ec37d65982d358c73d15a2a4708c82 Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Thu, 16 May 2013 20:09:39 +0200 Subject: Try different patch --- .../x11-wm/stumpwm/files/stumpwm-hex-colours.diff | 125 -------------------- .../x11-wm/stumpwm/files/stumpwm-hex-colours.patch | 130 +++++++++++++++++++++ packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 | 2 +- 3 files changed, 131 insertions(+), 126 deletions(-) delete mode 100644 packages/x11-wm/stumpwm/files/stumpwm-hex-colours.diff create mode 100644 packages/x11-wm/stumpwm/files/stumpwm-hex-colours.patch diff --git a/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.diff b/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.diff deleted file mode 100644 index dac1cff..0000000 --- a/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.diff +++ /dev/null @@ -1,125 +0,0 @@ -diff -r 6a36c0456b66 color.lisp ---- a/color.lisp Wed Dec 28 16:09:48 2011 +0100 -+++ b/color.lisp Tue Jan 03 18:44:44 2012 +0100 -@@ -66,29 +66,38 @@ - (xlib:alloc-color (xlib:screen-default-colormap (screen-number screen)) color)) - - (defun lookup-color (screen color) -- (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color)) -+ (flet ((hex () -+ (apply #'xlib:make-color -+ (loop for (x y) in '((:red 16) (:green 8) (:blue 0)) -+ nconcing (list x (/ (ldb (byte 8 y) color) -+ 256)))))) -+ (cond ((integerp color) (hex)) -+ ((typep color 'xlib:color) color) -+ (t (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color))))) - - ;; Normal colors are dimmed and bright colors are intensified in order - ;; to more closely resemble the VGA pallet. - (defun update-color-map (screen) - "Read *colors* and cache their pixel colors for use when rendering colored text." -- (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)) -- (screen-color-map-bright screen) (apply #'vector (map-colors 0.25)))))) -+ (labels ((map-colors (amt) -+ (loop for c in *colors* -+ as color = (lookup-color screen c) -+ do (adjust-color color amt) -+ collect (alloc-color screen color)))) -+ (let ((amt (if *bright-colors* -+ '(-0.25 . 0.25) -+ '(0.0 . 0.0)))) -+ (setf (screen-color-map-normal screen) (apply #'vector (map-colors (car amt))) -+ (screen-color-map-bright screen) (apply #'vector (map-colors (cdr amt))))))) - - (defun update-screen-color-context (screen) -- (let* ((cc (screen-message-cc screen)) -- (bright (lookup-color screen *text-color*))) -- (setf -- (ccontext-default-fg cc) (screen-fg-color screen) -- (ccontext-default-bg cc) (screen-bg-color screen)) -- (adjust-color bright 0.25) -- (setf (ccontext-default-bright cc) (alloc-color screen bright)))) -+ (let ((cc (screen-message-cc screen)) -+ (bright (lookup-color screen *text-color*))) -+ (when *bright-colors* -+ (adjust-color bright 0.25)) -+ (setf (ccontext-default-fg cc) (screen-fg-color screen) -+ (ccontext-default-bg cc) (screen-bg-color screen) -+ (ccontext-default-bright cc) (alloc-color screen bright)))) - - (defun get-bg-color (screen cc color) - (setf *background* color) -diff -r 6a36c0456b66 mode-line.lisp ---- a/mode-line.lisp Wed Dec 28 16:09:48 2011 +0100 -+++ b/mode-line.lisp Tue Jan 03 18:44:44 2012 +0100 -@@ -307,8 +307,8 @@ - (xlib:create-window - :parent parent - :x 0 :y 0 :width 1 :height 1 -- :background (alloc-color screen *mode-line-background-color*) -- :border (alloc-color screen *mode-line-border-color*) -+ :background (alloc-color screen (lookup-color screen *mode-line-background-color*)) -+ :border (alloc-color screen (lookup-color screen *mode-line-border-color*)) - :border-width *mode-line-border-width* - ;; You can click the modeline - :event-mask (xlib:make-event-mask :button-press :exposure) -@@ -375,15 +375,16 @@ - (defun make-mode-line-gc (window screen) - (xlib:create-gcontext :drawable window - :font (screen-font screen) -- :foreground (alloc-color screen *mode-line-foreground-color*) -- :background (alloc-color screen *mode-line-background-color*))) -+ :foreground (alloc-color screen (lookup-color screen *mode-line-foreground-color*)) -+ :background (alloc-color screen (lookup-color screen *mode-line-background-color*)))) - - - (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) -+ (when *bright-colors* -+ (adjust-color bright 0.25)) - (setf (ccontext-default-bright cc) (alloc-color screen bright)))) - - (defun make-head-mode-line (screen head format) -diff -r 6a36c0456b66 primitives.lisp ---- a/primitives.lisp Wed Dec 28 16:09:48 2011 +0100 -+++ b/primitives.lisp Tue Jan 03 18:44:44 2012 +0100 -@@ -109,6 +109,7 @@ - *default-group-name* - *window-border-style* - *data-dir* -+ *bright-colors* - add-hook - clear-window-placement-rules - concat -@@ -154,6 +155,9 @@ - (defvar *grab-pointer-count* 0 - "The number of times the pointer has been grabbed") - -+(defvar *bright-colors* t -+ "Make colors brighter. This is the default.") -+ - ;;; Hooks - - (defvar *command-mode-start-hook* '(command-mode-start-message) -diff -r 6a36c0456b66 screen.lisp ---- a/screen.lisp Wed Dec 28 16:09:48 2011 +0100 -+++ b/screen.lisp Tue Jan 03 18:44:44 2012 +0100 -@@ -256,7 +256,7 @@ - - (defmacro set-any-color (val color) - `(progn (dolist (s *screen-list*) -- (setf (,val s) (alloc-color s ,color))) -+ (setf (,val s) (alloc-color s (lookup-color s ,color)))) - (update-colors-all-screens))) - - ;; FIXME: I don't like any of this. Isn't there a way to define diff --git a/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.patch b/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.patch new file mode 100644 index 0000000..3541645 --- /dev/null +++ b/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.patch @@ -0,0 +1,130 @@ +diff --git a/color.lisp b/color.lisp +index 30396bc..57cebf1 100644 +--- a/color.lisp ++++ b/color.lisp +@@ -66,29 +66,38 @@ then call (update-color-map).") + (xlib:alloc-color (xlib:screen-default-colormap (screen-number screen)) color)) + + (defun lookup-color (screen color) +- (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color)) ++ (flet ((hex () ++ (apply #'xlib:make-color ++ (loop for (x y) in '((:red 16) (:green 8) (:blue 0)) ++ nconcing (list x (/ (ldb (byte 8 y) color) ++ 256)))))) ++ (cond ((integerp color) (hex)) ++ ((typep color 'xlib:color) color) ++ (t (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color))))) + + ;; Normal colors are dimmed and bright colors are intensified in order + ;; to more closely resemble the VGA pallet. + (defun update-color-map (screen) + "Read *colors* and cache their pixel colors for use when rendering colored text." +- (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)) +- (screen-color-map-bright screen) (apply #'vector (map-colors 0.25)))))) ++ (labels ((map-colors (amt) ++ (loop for c in *colors* ++ as color = (lookup-color screen c) ++ do (adjust-color color amt) ++ collect (alloc-color screen color)))) ++ (let ((amt (if *bright-colors* ++ '(-0.25 . 0.25) ++ '(0.0 . 0.0)))) ++ (setf (screen-color-map-normal screen) (apply #'vector (map-colors (car amt))) ++ (screen-color-map-bright screen) (apply #'vector (map-colors (cdr amt))))))) + + (defun update-screen-color-context (screen) +- (let* ((cc (screen-message-cc screen)) +- (bright (lookup-color screen *text-color*))) +- (setf +- (ccontext-default-fg cc) (screen-fg-color screen) +- (ccontext-default-bg cc) (screen-bg-color screen)) +- (adjust-color bright 0.25) +- (setf (ccontext-default-bright cc) (alloc-color screen bright)))) ++ (let ((cc (screen-message-cc screen)) ++ (bright (lookup-color screen *text-color*))) ++ (when *bright-colors* ++ (adjust-color bright 0.25)) ++ (setf (ccontext-default-fg cc) (screen-fg-color screen) ++ (ccontext-default-bg cc) (screen-bg-color screen) ++ (ccontext-default-bright cc) (alloc-color screen bright)))) + + (defun get-bg-color (screen cc color) + (setf *background* color) +diff --git a/mode-line.lisp b/mode-line.lisp +index d30dfb9..42c3bc2 100644 +--- a/mode-line.lisp ++++ b/mode-line.lisp +@@ -282,8 +282,8 @@ critical." + (xlib:create-window + :parent parent + :x 0 :y 0 :width 1 :height 1 +- :background (alloc-color screen *mode-line-background-color*) +- :border (alloc-color screen *mode-line-border-color*) ++ :background (alloc-color screen (lookup-color screen *mode-line-background-color*)) ++ :border (alloc-color screen (lookup-color screen *mode-line-border-color*)) + :border-width *mode-line-border-width* + ;; You can click the modeline + :event-mask (xlib:make-event-mask :button-press :exposure) +@@ -350,15 +350,16 @@ critical." + (defun make-mode-line-gc (window screen) + (xlib:create-gcontext :drawable window + :font (screen-font screen) +- :foreground (alloc-color screen *mode-line-foreground-color*) +- :background (alloc-color screen *mode-line-background-color*))) ++ :foreground (alloc-color screen (lookup-color screen *mode-line-foreground-color*)) ++ :background (alloc-color screen (lookup-color screen *mode-line-background-color*)))) + + + (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) ++ (when *bright-colors* ++ (adjust-color bright 0.25)) + (setf (ccontext-default-bright cc) (alloc-color screen bright)))) + + (defun make-head-mode-line (screen head format) +diff --git a/primitives.lisp b/primitives.lisp +index 50d062e..c37a028 100644 +--- a/primitives.lisp ++++ b/primitives.lisp +@@ -109,6 +109,7 @@ + *default-group-name* + *window-border-style* + *data-dir* ++ *bright-colors* + add-hook + clear-window-placement-rules + concat +@@ -153,6 +154,9 @@ be an integer.") + (defvar *grab-pointer-count* 0 + "The number of times the pointer has been grabbed") + ++(defvar *bright-colors* t ++ "Make colors brighter. This is the default.") ++ + ;;; Hooks + + (defvar *command-mode-start-hook* '(command-mode-start-message) +diff --git a/screen.lisp b/screen.lisp +index ab708c3..562dbf4 100644 +--- a/screen.lisp ++++ b/screen.lisp +@@ -249,7 +249,7 @@ identity with a range check." + + (defmacro set-any-color (val color) + `(progn (dolist (s *screen-list*) +- (setf (,val s) (alloc-color s ,color))) ++ (setf (,val s) (alloc-color s (lookup-color s ,color)))) + (update-colors-all-screens))) + + ;; FIXME: I don't like any of this. Isn't there a way to define + diff --git a/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 b/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 index b857b46..56e0505 100644 --- a/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 +++ b/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 @@ -28,7 +28,7 @@ DEPENDENCIES=" RESTRICT="strip" DEFAULT_SRC_PREPARE_PATCHES=( "${FILES}"/stumpwm-printing.patch - "${FILES}"/stumpwm-hex-colours.diff ) + "${FILES}"/stumpwm-hex-colours.patch ) DEFAULT_SRC_CONFIGURE_PARAMS=( --with-lisp=sbcl ) DEFAULT_SRC_COMPILE_PARAMS=( -j1 LISP='/usr/bin/sbcl --disable-debugger' ) -- cgit v1.2.3-54-g00ecf