From 27cb0dd97e27de7b27e2ee66e6c2f5158c68f519 Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Thu, 16 May 2013 19:58:00 +0200 Subject: [PATCH] Add stumpwm-scm --- metadata/categories.conf | 1 + .../stumpwm/files/stumpwm-exherbo.el.in | 1 + .../stumpwm/files/stumpwm-hex-colours.patch | 132 ++++++++++++++++++ .../stumpwm/files/stumpwm-printing.patch | 77 ++++++++++ packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 | 55 ++++++++ 5 files changed, 266 insertions(+) create mode 100644 packages/x11-wm/stumpwm/files/stumpwm-exherbo.el.in create mode 100644 packages/x11-wm/stumpwm/files/stumpwm-hex-colours.patch create mode 100644 packages/x11-wm/stumpwm/files/stumpwm-printing.patch create mode 100644 packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 diff --git a/metadata/categories.conf b/metadata/categories.conf index 1d62fe5..05b3059 100644 --- a/metadata/categories.conf +++ b/metadata/categories.conf @@ -2,3 +2,4 @@ app-security dev-lang dev-python media-sound +x11-wm diff --git a/packages/x11-wm/stumpwm/files/stumpwm-exherbo.el.in b/packages/x11-wm/stumpwm/files/stumpwm-exherbo.el.in new file mode 100644 index 0000000..9733d42 --- /dev/null +++ b/packages/x11-wm/stumpwm/files/stumpwm-exherbo.el.in @@ -0,0 +1 @@ +(autoload 'stumpwm-mode "stumpwm-mode" nil t) 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..c1f5929 --- /dev/null +++ b/packages/x11-wm/stumpwm/files/stumpwm-hex-colours.patch @@ -0,0 +1,132 @@ +diff --git a/color.lisp b/color.lisp +index 2085fbc..5ada58a 100644 +--- a/color.lisp ++++ b/color.lisp +@@ -66,31 +66,38 @@ then call (update-color-map).") + (xlib:alloc-color (xlib:screen-default-colormap (screen-number screen)) color)) + + (defun lookup-color (screen color) +- (cond +- ((typep color 'xlib:color) color) +- (t (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 = (lookup-color screen 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/files/stumpwm-printing.patch b/packages/x11-wm/stumpwm/files/stumpwm-printing.patch new file mode 100644 index 0000000..bea70b1 --- /dev/null +++ b/packages/x11-wm/stumpwm/files/stumpwm-printing.patch @@ -0,0 +1,77 @@ +Source: Elias Pipping +Upstream: no (pasted on irc) +Reason: A window whose title contains the string ^\ cannot have it printed + +From 56b478ae447ca8bf4b0d6d80e10fe00fb1c8d95b Mon Sep 17 00:00:00 2001 +From: Elias Pipping +Date: Sat, 5 Jan 2013 22:03:53 +0100 +Subject: [PATCH 1/2] Typo + +--- + primitives.lisp | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/primitives.lisp b/primitives.lisp +index 50d062e..3d42012 100644 +--- a/primitives.lisp ++++ b/primitives.lisp +@@ -753,7 +753,7 @@ do: + (format t "%~a~@[~a~]" len from-left-p) + (let* ((fmt (cadr (assoc (car cur) fmt-alist :test 'char=))) + (str (cond (fmt +- ;; it can return any type, not jut as string. ++ ;; it can return any type, not just a string. + (format nil "~a" (apply fmt args))) + ((char= (car cur) #\%) + (string #\%)) +-- +1.8.0.3 + +From db588e4393567b3016c2be57511d35d3c01e4e46 Mon Sep 17 00:00:00 2001 +From: Elias Pipping +Date: Sat, 5 Jan 2013 22:08:11 +0100 +Subject: [PATCH 2/2] Escape window information before printing + +Otherwise, a window with a title like ^\ will wreak havoc when +echo-string-list fails to parse it. +--- + primitives.lisp | 16 ++++++++++++++-- + 1 file changed, 14 insertions(+), 2 deletions(-) + +diff --git a/primitives.lisp b/primitives.lisp +index 3d42012..88b45d4 100644 +--- a/primitives.lisp ++++ b/primitives.lisp +@@ -732,6 +732,15 @@ do: + ;;; + ;;; formatting routines + ++(defun escape-string (str) ++ (let (buf) ++ (map nil #'(lambda (ch) ++ (push ch buf) ++ (when (char= ch #\^) ++ (push ch buf))) ++ str) ++ (coerce (reverse buf) 'string))) ++ + (defun format-expand (fmt-alist fmt &rest args) + (let* ((chars (coerce fmt 'list)) + (output "") +@@ -753,8 +762,11 @@ do: + (format t "%~a~@[~a~]" len from-left-p) + (let* ((fmt (cadr (assoc (car cur) fmt-alist :test 'char=))) + (str (cond (fmt +- ;; it can return any type, not just a string. +- (format nil "~a" (apply fmt args))) ++ ;; Any sequence that could be interpreted as ++ ;; a colorisation directive is escaped here ++ (escape-string ++ ;; it can return any type, not just a string. ++ (format nil "~a" (apply fmt args)))) + ((char= (car cur) #\%) + (string #\%)) + (t +-- +1.8.0.3 + diff --git a/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 b/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 new file mode 100644 index 0000000..56e0505 --- /dev/null +++ b/packages/x11-wm/stumpwm/stumpwm-scm.exheres-0 @@ -0,0 +1,55 @@ +# Copyright 2011 Elias Pipping +# Distributed under the terms of the GNU General Public License v2 + +require github [ user=sabetts ] autotools [ supported_autoconf=[ 2.5 ] supported_automake=[ none ] ] +require elisp-optional [ source_directory=contrib ] + +SUMMARY="A tiling, keyboard driven X11 Window Manager written entirely in Common Lisp" +HOMEPAGE="http://www.nongnu.org/stumpwm/" + +LICENCES="GPL-2" +SLOT="0" +PLATFORMS="~amd64" +MYOPTIONS="emacs" + +DEPENDENCIES=" + build: + dev-lisp/cl-ppcre + dev-lisp/clx[~scm] + build+run: + dev-lang/sbcl [[ note = [ contains asdf ] ]] + suggestion: + ( + app-misc/rlwrap + x11-apps/xprop + ) [[ *description = [ For stumpish ] ]] +" + +RESTRICT="strip" + +DEFAULT_SRC_PREPARE_PATCHES=( "${FILES}"/stumpwm-printing.patch + "${FILES}"/stumpwm-hex-colours.patch ) +DEFAULT_SRC_CONFIGURE_PARAMS=( --with-lisp=sbcl ) +DEFAULT_SRC_COMPILE_PARAMS=( -j1 LISP='/usr/bin/sbcl --disable-debugger' ) + +src_prepare() { + default + eautoconf +} + +src_compile() { + default + elisp-optional_src_compile +} + +src_install() { + emake install destdir="${IMAGE}" + + insinto /usr/share/${PN}/contrib + doins contrib/*.lisp + + dobin contrib/stumpish + + elisp-optional_src_install +} +