[clfswm-cvs] r198 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sat Dec 20 19:57:00 UTC 2008
Author: pbrochard
Date: Sat Dec 20 19:57:00 2008
New Revision: 198
Log:
get-color: Allocate colors only once -> fix a segfault with clisp/new-clx.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-info.lisp
clfswm/src/xlib-util.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat Dec 20 19:57:00 2008
@@ -1,5 +1,8 @@
2008-12-20 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/xlib-util.lisp (get-color): Allocate colors only once -> fix
+ a segfault with clisp/new-clx.
+
* src/clfswm.lisp (handle-motion-notify): Add a needed window
argument.
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Sat Dec 20 19:57:00 2008
@@ -41,14 +41,14 @@
-
(defun draw-info-window (info)
(labels ((print-line (line posx posy &optional (color *info-foreground*))
- (setf (xlib:gcontext-foreground (info-gc info)) (get-color color))
- (xlib:draw-glyphs *pixmap-buffer* (info-gc info)
- (- (+ (info-ilw info) (* posx (info-ilw info))) (info-x info))
- (- (+ (* (info-ilh info) posy) (info-ilh info)) (info-y info))
- (format nil "~A" line))
+ ;;(setf (xlib:gcontext-foreground (info-gc info)) (get-color color))
+ (xlib:with-gcontext ((info-gc info) :foreground (get-color color))
+ (xlib:draw-glyphs *pixmap-buffer* (info-gc info)
+ (- (+ (info-ilw info) (* posx (info-ilw info))) (info-x info))
+ (- (+ (* (info-ilh info) posy) (info-ilh info)) (info-y info))
+ (format nil "~A" line)))
(+ posx (length line))))
(clear-pixmap-buffer (info-window info) (info-gc info))
(loop for line in (info-list info)
@@ -64,7 +64,7 @@
(t (print-line line 0 y))))
(copy-pixmap-buffer (info-window info) (info-gc info))))
-
+
@@ -294,7 +294,7 @@
(defun info-mode-menu (item-list &key (x 0) (y 0) (width nil) (height nil))
"Open an info help menu.
Item-list is: '((key function) separator (key function))
-or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function))
+or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function))
key is a character, a keycode or a keysym
Separator is a string or a symbol (all but a list)
Function can be a function or a list (function color) for colored output"
@@ -353,7 +353,7 @@
(list (subseq line 22 35) *info-color-first*)
(subseq line 35)))
(t line))))
-
+
(defun show-key-binding (&rest hash-table-key)
"Show the binding of each hash-table-key"
@@ -389,7 +389,7 @@
(if pos
(list (list (subseq line 0 (1+ pos)) *info-color-first*)
(subseq line (1+ pos)))
- line)))
+ line)))
(t line))))
(defun show-corner-help ()
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Sat Dec 20 19:57:00 2008
@@ -114,7 +114,7 @@
(defun window-hidden-p (window)
(eql (window-state window) +iconic-state+))
-
+
(defun unhide-window (window)
(when window
@@ -144,13 +144,13 @@
;; "_NET_DESKTOP_VIEWPORT" "_NET_DESKTOP_NAMES"
;; "_NET_ACTIVE_WINDOW" "_NET_WORKAREA"
;; "_NET_SUPPORTING_WM_CHECK" "_NET_VIRTUAL_ROOTS"
-;; "_NET_DESKTOP_LAYOUT"
+;; "_NET_DESKTOP_LAYOUT"
;;
;; "_NET_RESTACK_WINDOW" "_NET_REQUEST_FRAME_EXTENTS"
;; "_NET_MOVERESIZE_WINDOW" "_NET_CLOSE_WINDOW"
;; "_NET_WM_MOVERESIZE"
;;
-;; "_NET_WM_SYNC_REQUEST" "_NET_WM_PING"
+;; "_NET_WM_SYNC_REQUEST" "_NET_WM_PING"
;;
;; "_NET_WM_NAME" "_NET_WM_VISIBLE_NAME"
;; "_NET_WM_ICON_NAME" "_NET_WM_VISIBLE_ICON_NAME"
@@ -173,7 +173,7 @@
;; "_NET_WM_STATE_ABOVE"
;; "_NET_WM_STATE_BELOW"
;; "_NET_WM_STATE_DEMANDS_ATTENTION"
-;;
+;;
;; "_NET_WM_ALLOWED_ACTIONS"
;; "_NET_WM_ACTION_MOVE"
;; "_NET_WM_ACTION_RESIZE"
@@ -207,7 +207,7 @@
;;(defun set-atoms-property (window atoms property-atom &key (mode :replace))
;; "Sets the property designates by `property-atom'. ATOMS is a list of atom-id
;; or a list of keyword atom-names."
-;; (xlib:change-property window property-atom atoms :ATOM 32
+;; (xlib:change-property window property-atom atoms :ATOM 32
;; :mode mode
;; :transform (unless (integerp (car atoms))
;; (lambda (atom-key)
@@ -323,7 +323,7 @@
(defun no-focus ()
"don't focus any window but still read keyboard events."
(xlib:set-input-focus *display* *no-focus-window* :pointer-root))
-
+
@@ -343,7 +343,7 @@
(defun xgrab-pointer-p ()
pointer-grabbed)
-
+
(defun xgrab-pointer (root cursor-char cursor-mask-char
&optional (pointer-mask '(:enter-window :pointer-motion
:button-press :button-release)) owner-p)
@@ -379,12 +379,12 @@
(defun xgrab-keyboard-p ()
keyboard-grabbed)
-
+
(defun xgrab-keyboard (root)
(setf keyboard-grabbed t)
(xlib:grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))
-
+
(defun xungrab-keyboard ()
(setf keyboard-grabbed nil)
(xlib:ungrab-keyboard *display*)))
@@ -392,7 +392,7 @@
-
+
(defun ungrab-all-buttons (window)
(xlib:ungrab-button window :any :modifiers :any))
@@ -447,7 +447,7 @@
-;;; Mouse action on window
+;;; Mouse action on window
(defun move-window (window orig-x orig-y &optional additional-fn additional-arg)
(raise-window window)
(let ((done nil)
@@ -502,7 +502,7 @@
(unless (compress-motion-notify)
(setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x orig-x)) 10 min-width) max-width)
(xlib:drawable-height window) (min (max (+ orig-height (- root-y orig-y)) 10 min-height) max-height))
- (when additional-fn
+ (when additional-fn
(apply additional-fn additional-arg))))
(handle-event (&rest event-slots &key event-key &allow-other-keys)
(case event-key
@@ -559,8 +559,15 @@
-(defun get-color (color)
- (xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
+(let ((color-hash (make-hash-table :test 'equal)))
+ (defun get-color (color)
+ (multiple-value-bind (val foundp)
+ (gethash color color-hash)
+ (if foundp
+ val
+ (setf (gethash color color-hash)
+ (xlib:alloc-color (xlib:screen-default-colormap *screen*) color))))))
+
(defgeneric ->color (color))
@@ -653,7 +660,7 @@
(xungrab-pointer))
(unless keyboard-grabbed
(xungrab-keyboard))))
-
+
@@ -727,7 +734,7 @@
(xlib:draw-rectangle *pixmap-buffer* gc
0 0 (xlib:drawable-width window) (xlib:drawable-height window)
t)
- (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc)))
+ (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc)))
(defun copy-pixmap-buffer (window gc)
(xlib:copy-area *pixmap-buffer* gc
More information about the clfswm-cvs
mailing list