[clfswm-cvs] r110 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Fri May 2 14:13:45 UTC 2008
Author: pbrochard
Date: Fri May 2 10:13:43 2008
New Revision: 110
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-query.lisp
clfswm/src/clfswm-second-mode.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/package.lisp
clfswm/src/xlib-util.lisp
Log:
Display all texts with a double buffering method
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri May 2 10:13:43 2008
@@ -1,3 +1,17 @@
+2008-05-02 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (identify-key): Use a double buffer to
+ display text.
+
+ * src/clfswm-query.lisp (query-string): Use a double buffer to
+ display text.
+
+ * src/clfswm-info.lisp (draw-info-window): Use a double buffer to
+ display text.
+
+ * src/xlib-util.lisp (clear-pixmap-buffer, copy-pixmap-buffer):
+ New functions.
+
2008-05-01 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-info.lisp (info-mode): Add boundaries in the info mode window.
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Fri May 2 10:13:43 2008
@@ -9,9 +9,6 @@
- Ensure-unique-number/name (new function) [Philippe]
-- Double buffering for all text windows. [Philippe]
-
-
MAYBE
=====
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Fri May 2 10:13:43 2008
@@ -54,6 +54,9 @@
(define-second-key ("m") 'open-menu)
+(define-second-key (#\<) 'open-menu)
+(define-second-key (#\< :control) 'open-menu)
+
(define-second-key ("f") 'open-frame-menu)
(define-second-key ("w") 'open-window-menu)
(define-second-key ("n") 'open-action-by-name-menu)
@@ -73,10 +76,6 @@
(define-second-key ("Escape") 'leave-second-mode)
-(define-second-key (#\< :control) 'leave-second-mode)
-
-
-
(define-second-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Fri May 2 10:13:43 2008
@@ -40,40 +40,17 @@
+
+
(defun draw-info-window (info)
- (xlib:clear-area (info-window info))
- (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+ (clear-pixmap-buffer (info-window info) (info-gc info))
(loop for line in (info-list info)
for y from 0 do
- (xlib:draw-image-glyphs (info-window info) (info-gc info)
- (- (info-ilw info) (info-x info))
- (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
- (format nil "~A" line))))
-
-
-(defun draw-info-window-partial (info)
- (let ((last-y (info-y info)))
- (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
- (xlib:draw-rectangle (info-window info) (info-gc info) 0 0
- (xlib:drawable-width (info-window info))
- (max (+ (- (info-y info)) (xlib:max-char-ascent (info-font info))) 0) t)
- (loop for line in (info-list info)
- for y from 0 do
- (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
- (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
- (xlib:draw-rectangle (info-window info) (info-gc info)
- 0 (+ last-y (- (info-ilh info)) (xlib:max-char-descent (info-font info)))
- (xlib:drawable-width (info-window info)) (info-ilh info) t)
- (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
- (xlib:draw-image-glyphs (info-window info) (info-gc info)
- (- (info-ilw info) (info-x info))
- last-y
- (format nil "~A" line)))
- (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
- (xlib:draw-rectangle (info-window info) (info-gc info) 0 last-y
- (xlib:drawable-width (info-window info))
- (xlib:drawable-height (info-window info))
- t)))
+ (xlib:draw-glyphs *pixmap-buffer* (info-gc info)
+ (- (info-ilw info) (info-x info))
+ (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
+ (format nil "~A" line)))
+ (copy-pixmap-buffer (info-window info) (info-gc info)))
;;;,-----
@@ -185,8 +162,7 @@
(when (and *info-start-grab-x* *info-start-grab-y*)
(setf (info-x info) (min (max (- *info-start-grab-x* root-x) 0) (info-max-x info))
(info-y info) (min (max (- *info-start-grab-y* root-y) 0) (info-max-y info)))
- (draw-info-window-partial info)))
-
+ (draw-info-window info)))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri May 2 10:13:43 2008
@@ -335,37 +335,34 @@
-
-;;; TODO: Double buffering for frame window
(defun display-frame-info (frame)
(let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
(with-slots (name number gc window child) frame
- (xlib:clear-area window)
+ (clear-pixmap-buffer window gc)
(setf (xlib:gcontext-foreground gc) (get-color (if (and (equal frame *current-root*)
(equal frame *current-child*))
"Red" "Green")))
- (xlib:draw-image-glyphs window gc 5 dy
- (format nil "Frame: ~A~A"
- number
- (if name (format nil " - ~A" name) "")))
+ (xlib:draw-glyphs *pixmap-buffer* gc 5 dy
+ (format nil "Frame: ~A~A"
+ number
+ (if name (format nil " - ~A" name) "")))
(let ((pos dy))
(when (equal frame *current-root*)
- (xlib:draw-image-glyphs window gc 5 (incf pos dy)
- (format nil "~A hidden windows" (length (get-hidden-windows))))
+ (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
+ (format nil "~A hidden windows" (length (get-hidden-windows))))
(when *child-selection*
- (xlib:draw-image-glyphs window gc 5 (incf pos dy)
- (with-output-to-string (str)
- (format str "Selection: ")
- (dolist (child *child-selection*)
- (typecase child
- (xlib:window (format str "~A " (xlib:wm-name child)))
- (frame (format str "frame:~A[~A] " (frame-number child)
- (aif (frame-name child) it "")))))))))
+ (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
+ (with-output-to-string (str)
+ (format str "Selection: ")
+ (dolist (child *child-selection*)
+ (typecase child
+ (xlib:window (format str "~A " (xlib:wm-name child)))
+ (frame (format str "frame:~A[~A] " (frame-number child)
+ (aif (frame-name child) it "")))))))))
(dolist (ch child)
(when (xlib:window-p ch)
- (xlib:draw-image-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch)))))))))
-
-
+ (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))
+ (copy-pixmap-buffer window gc))))
Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp (original)
+++ clfswm/src/clfswm-query.lisp Fri May 2 10:13:43 2008
@@ -84,13 +84,14 @@
(labels ((add-cursor (string)
(concatenate 'string (subseq string 0 pos) "|" (subseq string pos)))
(print-string ()
- (xlib:clear-area window)
+ (clear-pixmap-buffer window gc)
(setf (xlib:gcontext-foreground gc) (get-color *query-foreground*))
- (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5) msg)
+ (xlib:draw-glyphs *pixmap-buffer* gc 5 (+ (xlib:max-char-ascent font) 5) msg)
(when (< pos 0) (setf pos 0))
(when (> pos (length result-string)) (setf pos (length result-string)))
- (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
- (add-cursor (query-show-paren result-string pos))))
+ (xlib:draw-glyphs *pixmap-buffer* gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (add-cursor (query-show-paren result-string pos)))
+ (copy-pixmap-buffer window gc))
(call-backspace (modifiers)
(let ((del-pos (if (member :control modifiers)
(or (position #\Space result-string :from-end t :end pos) 0)
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Fri May 2 10:13:43 2008
@@ -55,13 +55,14 @@
(defun draw-second-mode-window ()
(raise-window *sm-window*)
- (xlib:clear-area *sm-window*)
+ (clear-pixmap-buffer *sm-window* *sm-gc*)
(let* ((text (format nil "Second mode"))
(len (length text)))
- (xlib:draw-image-glyphs *sm-window* *sm-gc*
- (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
- (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
- text)))
+ (xlib:draw-glyphs *pixmap-buffer* *sm-gc*
+ (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
+ (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
+ text))
+ (copy-pixmap-buffer *sm-window* *sm-gc*))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri May 2 10:13:43 2008
@@ -223,19 +223,20 @@
(labels ((print-doc (msg hash-table-key pos code state)
(let ((function (find-key-from-code hash-table-key code state)))
(when (and function (fboundp (first function)))
- (xlib:draw-image-glyphs window gc 10 (+ (* pos (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
- (format nil "~A ~A" msg (documentation (first function) 'function))))))
+ (xlib:draw-glyphs *pixmap-buffer* gc 10 (+ (* pos (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (format nil "~A ~A" msg (documentation (first function) 'function))))))
(print-key (code state keysym key modifiers)
- (xlib:clear-area window)
+ (clear-pixmap-buffer window gc)
(setf (xlib:gcontext-foreground gc) (get-color *identify-foreground*))
- (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5)
- (format nil "Press a key to identify. Press 'q' to stop the identify loop."))
+ (xlib:draw-glyphs *pixmap-buffer* gc 5 (+ (xlib:max-char-ascent font) 5)
+ (format nil "Press a key to identify. Press 'q' to stop the identify loop."))
(when code
- (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
- (format nil "Code=~A KeySym=~S Key=~S Modifiers=~A"
- code keysym key modifiers))
+ (xlib:draw-glyphs *pixmap-buffer* gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+ (format nil "Code=~A KeySym=~S Key=~S Modifiers=~A"
+ code keysym key modifiers))
(print-doc "Main mode : " *main-keys* 3 code state)
- (print-doc "Second mode: " *second-keys* 4 code state)))
+ (print-doc "Second mode: " *second-keys* 4 code state))
+ (copy-pixmap-buffer window gc))
(handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
(let* ((modifiers (state->modifiers state))
@@ -839,7 +840,7 @@
(defmacro with-current-window (&body body)
"Bind 'window' to the current window"
`(let ((window (get-current-window)))
- (when window
+ (when (xlib:window-p window)
, at body)))
@@ -848,7 +849,7 @@
;;; Force window functions
(defun force-window-in-frame ()
- "Force the current window to move in the frame (Useful only for transient windows)"
+ "Force the current window to move in the frame (Useful only for unmanaged windows)"
(with-current-window
(let ((parent (find-parent-frame window)))
(with-xlib-protect
@@ -858,7 +859,7 @@
(defun force-window-center-in-frame ()
- "Force the current window to move in the center of the frame (Useful only for transient windows)"
+ "Force the current window to move in the center of the frame (Useful only for unmanaged windows)"
(with-current-window
(let ((parent (find-parent-frame window)))
(with-xlib-protect
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Fri May 2 10:13:43 2008
@@ -199,7 +199,11 @@
:foreground (get-color *color-unselected*)
:background (get-color "Black")
:line-style :solid)
- *default-font* (xlib:open-font *display* *default-font-string*))
+ *default-font* (xlib:open-font *display* *default-font-string*)
+ *pixmap-buffer* (xlib:create-pixmap :width (xlib:screen-width *screen*)
+ :height (xlib:screen-height *screen*)
+ :depth (xlib:screen-root-depth *screen*)
+ :drawable *root*))
(xgrab-init-pointer)
(xgrab-init-keyboard)
(xlib:map-window *no-focus-window*)
@@ -274,6 +278,7 @@
(main-loop))
(ungrab-main-keys)
(xlib:destroy-window *no-focus-window*)
+ (xlib:free-pixmap *pixmap-buffer*)
(xlib:close-display *display*)))
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Fri May 2 10:13:43 2008
@@ -39,6 +39,8 @@
(defparameter *no-focus-window* nil)
(defparameter *root-gc* nil)
+(defparameter *pixmap-buffer* nil)
+
(defparameter *contrib-dir* "")
(defparameter *default-font* nil)
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Fri May 2 10:13:43 2008
@@ -540,7 +540,6 @@
(pointer-grabbed-p (xgrab-pointer-p)))
(labels ((handle-event (&rest event-slots &key event-key &allow-other-keys)
(case event-key
- ;;(:motion-notify (apply #'motion-notify event-slots))
(:button-release (setf done t))
(:configure-request (call-hook *configure-request-hook* event-slots))
(:configure-notify (call-hook *configure-notify-hook* event-slots))
@@ -654,3 +653,20 @@
(dbg i)
(sleep display-time)
(xungrab-pointer)))
+
+
+
+
+;;; Double buffering tools
+(defun clear-pixmap-buffer (window gc)
+ (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc))
+ (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)))
+
+(defun copy-pixmap-buffer (window gc)
+ (xlib:copy-area *pixmap-buffer* gc
+ 0 0 (xlib:drawable-width window) (xlib:drawable-height window)
+ window 0 0))
+
More information about the clfswm-cvs
mailing list