Merge branch 'master' into test-merge

Conflicts:

	core.lisp
	package.lisp
	primitives.lisp
	sample-stumpwmrc.lisp
	stumpwm.lisp
	user.lisp

Makefile.in

@@ -9,7 +9,7 @@ LISP_OPTS= $(@LISP@_OPTS)
 
 # This is copied from the .asd file. It'd be nice to have the list in
 # one place, but oh well.
-FILES=package.lisp primitives.lisp keysyms.lisp keytrans.lisp kmap.lisp input.lisp core.lisp user.lisp mode-line.lisp stumpwm.lisp version.lisp make-image.lisp
+FILES=package.lisp primitives.lisp keysyms.lisp keytrans.lisp kmap.lisp input.lisp core.lisp user.lisp mode-line.lisp color.lisp stumpwm.lisp version.lisp make-image.lisp
 
 all: stumpwm.info stumpwm
 

NEWS

@@ -5,6 +5,10 @@ This file documents user visible changes between versions of StumpWM
 * Changes since 0.0.6
 These changes are probably incomplete
 
+** added color codes to message windows.
+
+** added XRandR dynamic rotate/resize support
+
 ** added external panel/dock support
 
 ** added fullscren support

color.lisp

@@ -0,0 +1,176 @@
+;; Copyright (C) 2007 Jonathan Moore Liles
+;;
+;;  This file is part of stumpwm.
+;;
+;; stumpwm is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; stumpwm is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this software; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;; Boston, MA 02111-1307 USA
+
+;; Commentary:
+;;
+;; This simplified implementation of the the C color code is as follows:
+;;
+;; ^B bright
+;; ^b dim
+;; ^n normal (sgr0)
+;;
+;; ^00 black black
+;; ^10 red black
+;; ^01 black red
+;; ^1* red clear
+;;
+;; and so on.
+;;
+;; I won't explain here the many reasons that C is better than ANSI, so just
+;; take my word for it.
+
+(in-package :stumpwm)
+
+(export '(*colors* update-color-map adjust-color update-screen-color-context))
+
+;; Eight colors. You can redefine these to whatever you like (and
+;; then call (update-color-map)).
+(defvar *colors*
+  '("black"
+    "red"
+    "green"
+    "yellow"
+    "blue"
+    "magenta"
+    "cyan"
+    "white"))
+
+(defvar *color-map* nil)
+(defvar *foreground* nil)
+(defvar *background* nil)
+
+(defun adjust-color (color amt)
+  (labels ((max-min (x y) (max 0 (min 1 (+ x y)))))
+    (setf (xlib:color-red color) (max-min (xlib:color-red color) amt)
+          (xlib:color-green color) (max-min (xlib:color-green color) amt)
+          (xlib:color-blue color) (max-min (xlib:color-blue color) amt))))
+
+(defun alloc-color (screen color)
+  (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))
+
+;; Normal colors are dimmed and bright colors are intensified in order
+;; to more closely resemble the VGA pallet.
+(defun update-color-map (screen)
+  (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))))))
+
+(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))))
+
+(defun get-bg-color (screen cc color)
+  (setf *background* color)
+  (if color
+      (svref (screen-color-map-normal screen) color)
+      (ccontext-default-bg cc)))
+
+(defun get-fg-color (screen cc color)
+  (setf *foreground* color)
+  (if color
+      (svref *color-map* color)
+      (if (eq *color-map* (screen-color-map-bright screen))
+          (ccontext-default-bright cc)
+          (ccontext-default-fg cc))))
+
+(defun set-color (screen cc s i)
+  (let* ((gc (ccontext-gc cc))
+         (l (- (length s) i))
+         (r 2)
+         (f (subseq s i (1+ i)))
+         (b (if (< l 2) "*" (subseq s (1+ i) (+ i 2)))))
+    (labels ((update-colors ()
+               (setf
+                (xlib:gcontext-foreground gc) (get-fg-color screen cc *foreground*)
+                (xlib:gcontext-background gc) (get-bg-color screen cc *background*))))
+      (case (elt f 0)
+        (#\n                            ; normal
+         (setf f "*" b "*" r 1
+               *color-map* (screen-color-map-normal screen))
+         (get-fg-color screen cc nil)
+         (get-bg-color screen cc nil))
+        (#\b                            ; bright off
+         (setf *color-map* (screen-color-map-normal screen))
+         (update-colors)
+         (return-from set-color 1))
+        (#\B                            ; bright on
+         (setf *color-map* (screen-color-map-bright screen))
+         (update-colors)
+         (return-from set-color 1))
+        (#\^                            ; circumflex
+         (return-from set-color 1)))
+      (handler-case
+          (let ((fg (if (equal f "*") (progn (get-fg-color screen cc nil) (ccontext-default-fg cc)) (get-fg-color screen cc (parse-integer f))))
+                (bg (if (equal b "*") (progn (get-bg-color screen cc nil) (ccontext-default-bg cc)) (get-bg-color screen cc (parse-integer b)))))
+            (setf (xlib:gcontext-foreground gc) fg
+                  (xlib:gcontext-background gc) bg))
+        (error (c) (dformat 1 "Invalid color code: ~A" c)))) r))
+
+(defun render-strings (screen cc padx pady strings highlights &optional (draw t))
+  (let* ((height (+ (xlib:font-descent (screen-font screen))
+                    (xlib:font-ascent (screen-font screen))))
+         (width 0)
+         (gc (ccontext-gc cc))
+         (win (ccontext-win cc))
+         (*foreground* nil)
+         (*background* nil)
+         (*color-map* (screen-color-map-normal screen)))
+    (loop for s in strings
+          ;; We need this so we can track the row for each element
+          for i from 0 to (length strings)
+          do (let ((x 0) (off 0))
+               (loop
+                for st = 0 then (+ en (1+ off))
+                as en = (position #\^ s :start st)
+                do (progn
+                     (let ((en (if (and en (eq #\^ (elt s (1+ en)))) (1+ en) en)))
+                       (when draw
+                         (xlib:draw-image-glyphs win gc
+                                                 (+ padx x)
+                                                 (+ pady (* i height)
+                                                    (xlib:font-ascent (screen-font screen)))
+                                                 (subseq s st en)
+                                                 :translate #'translate-id
+                                                 :size 16))
+                       (setf x (+ x (xlib:text-width (screen-font screen) (subseq s st en) :translate #'translate-id))))
+                     (when en
+                       (setf off (set-color screen cc s (1+ en))))
+                     (setf width (max width x)))
+                while en))
+          when (find i highlights :test 'eql)
+          do (when draw (invert-rect screen win
+                                     0 (* i height)
+                                     (xlib:drawable-width win)
+                                     height)))
+    (set-color screen cc "n" 0)
+    width))
+

contrib/stumpish

@@ -0,0 +1,113 @@
+#!/bin/sh
+
+# Copyright (C) 2007 Jonathan Moore Liles
+#
+# stumpish is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# stumpish is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this software; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+# Boston, MA 02111-1307 USA
+
+### STUMPwm Interactive Shell.
+
+function wait_result ()
+{
+	while true
+	do
+		RESULT=`xprop -root -f STUMPWM_COMMAND_RESULT 8s STUMPWM_COMMAND_RESULT 2>/dev/null`
+
+		if echo "$RESULT" | grep -v -q 'not found.$'
+		then
+			break;
+		fi
+
+		sleep 1;
+	done
+
+	xprop -root -remove STUMPWM_COMMAND_RESULT
+
+	if echo "$RESULT" | grep -q '= $'
+	then
+		return 1;
+	fi
+
+	echo $RESULT | sed 's/[^"]*"//;s/"$//;s/\\n/\n/g;s/\\"/"/g;s/\n\+$//;
+			s/\^[*[:digit:]]\{2\}//g;s/\^[Bbn]//g;'
+}
+
+function send_cmd ()
+{
+	xprop -root -f STUMPWM_COMMAND 8s -set STUMPWM_COMMAND "$1"
+
+	wait_result
+}
+
+function usage ()
+{
+cat <<EOF
+Usage: stumpish [[-e] command [args...]]
+
+StumpIsh is the StumpWM shell. Use it to interact a running StumpWM
+instance.  When run from a terminal with no arguments, stumpish
+accepts commands interactively and prints each result.  If standard
+input is a pipe, stumpish executes any number of commands and prints
+the concatenated results. If the '-e' option and one argument are
+given on the command line, stumpish reads any number of lines from
+standard input and uses them as the argument to the named command.
+Otherwise if one or more arguments are provided on the command line,
+the first is considered the name of the command to execute, and the
+remainder are concatenated to form the argument.
+
+Example:
+	echo '(group-windows (current-group))' | stumpish eval
+EOF
+exit 0;
+}
+
+if [ $# -gt 0 ]
+then
+	[ "$1" == "--help" ] && usage
+	if [ $1 == "-e" ]
+	then
+		if [ $# -ne 2 ]
+		then
+			echo "'-e' require exactly one argument!"
+			exit
+		fi
+		shift 1
+		IFS=''
+		ARGS=`cat /dev/stdin`
+		send_cmd "$1 $ARGS"
+	else
+		IFS=' '
+		send_cmd "$*"
+	fi
+else
+IFS='
+'
+	if [ -t 0 ]
+	then
+		echo -e '\e[1;35mWelcome to the StumpWM Interactive Shell.\n\e[37mType \e[32mcommands\e[37m for a list of commands.\e[0m'
+		while read -p "> "
+		do
+			echo -ne '\e[1;32m'
+			send_cmd "$REPLY"
+			echo -ne '\e[0m'
+		done
+	else
+		while read
+		do
+			send_cmd "$REPLY"
+		done
+	fi
+fi
+