[clfswm-cvs] r153 - in clfswm: . doc src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sat Aug 23 21:16:43 UTC 2008
Author: pbrochard
Date: Sat Aug 23 17:16:39 2008
New Revision: 153
Added:
clfswm/doc/corner.html
clfswm/doc/corner.txt
clfswm/src/clfswm-corner.lisp
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/clfswm.asd
clfswm/doc/keys.html
clfswm/doc/keys.txt
clfswm/doc/menu.html
clfswm/doc/menu.txt
clfswm/src/bindings-second-mode.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-autodoc.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-menu.lisp
clfswm/src/clfswm-nw-hooks.lisp
clfswm/src/clfswm-second-mode.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/config.lisp
clfswm/src/menu-def.lisp
clfswm/src/package.lisp
clfswm/src/tools.lisp
clfswm/src/xlib-util.lisp
Log:
Massive update: Fast layout switch, switch to last child, color nearly everywhere (Help, keys...), simple way for corners configuration, auto-doc on corners, show configuration variables
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat Aug 23 17:16:39 2008
@@ -1,3 +1,54 @@
+2008-08-23 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-info.lisp (show-config-variable): New function.
+
+2008-08-19 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-layout.lisp (tile-horizontal-layout): New layout.
+
+ * src/clfswm-info.lisp: Colored help for key binding and corners
+ actions.
+
+2008-08-18 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (delete-focus-window)
+ (destroy-focus-window): Remove chid only in
+ handle-unmap/destroy-notify. Focus *current-root* only when
+ closing/killing the current child.
+
+ * src/clfswm-autodoc.lisp (produce-corner-*-doc): New autodoc
+ functions or corners.
+
+2008-08-17 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-corner.lisp (present-clfswm-terminal): New corner
+ action: Hide/Unhide a terminal on mouse corner action. (By default
+ right mouse button on the top left corner).
+
+ * src/config.lisp (*never-managed-window-list*): New config
+ variable.
+
+ * src/clfswm-internal.lisp (never-managed-window-p): New function:
+ Handle never managed window in a more simple way.
+
+ * src/clfswm-corner.lisp: New file and new and more simple method
+ to define corners actions.
+
+2008-08-15 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-info.lisp (info-mode): Info line can now be colored.
+
+ * src/clfswm-layout.lisp (fast-layout-switch)
+ (define-fast-layout-switch): New functions: Switch between two
+ layouts.
+
+ * src/clfswm-second-mode.lisp (leave-second-mode): Takes care if
+ really in the second mode. So leave-second-mode can be used even
+ in the main mode.
+
+ * src/clfswm-util.lisp (switch-to-last-child): New function:
+ Store the current child and switch to the previous one.
+
2008-07-16 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-util.lisp (display-current-window-info): Display the
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Sat Aug 23 17:16:39 2008
@@ -7,11 +7,7 @@
===============
Should handle these soon.
-- Show config -> list and display documentation for all tweakable global variables. [Philippe]
-
-- Fast switch between two children. [Philippe]
-
-- Fast layout switch [Philippe]
+- Factorize layout
- A Gimp layout example (a main window and all others on the left) [Philippe]
@@ -19,18 +15,29 @@
- Ensure-unique-number/name (new function) [Philippe]
+- Show config -> list and display documentation for all tweakable global variables. [Philippe]
+ A finir : remove src/test.lisp src/load-test.lisp
+ Dans ~/.clfswmrc:
+ ;;;; AUTO-CONFIG - Do not edit those lines by hands: they are overwritten by CLFSWM
+ (defparameter *ma-var* value)
+ ...
+ ;;;; AUTO-CONFIG End : You can add your configurations below this line.
+
+- Focus policy by frame
MAYBE
=====
-- cd/pwd a la shell to navigate throw frames. [Philippe]
+- cd/pwd a la shell to navigate throw frames. [Philippe]
- From stumpwm: [Philippe]
"In other news stumpwm should catch unhandled errors, restart, and
print an error message. And there is now a soft-restart command. With
this in place I suspect you will need to restart stumpwm very rarely
and it won't spontaneously bring down X."
+ => Reset all -> place clfswm in its starting state.
+
- Zoom
@@ -46,8 +53,14 @@
* up
* down
-- Remote access to the clfswm REPL [Philippe]
-
- Undo/redo (any idea to implement this is welcome)
-- Mouse support in menu?
\ No newline at end of file
+- Mouse support in menu?
+
+- Remote access to the clfswm REPL [Philippe]
+ Protocol: Server: Ask: random-number
+ Client: Reply: associated random-number
+ Server: Ok
+ Client: a lisp form (+ 2 2)
+ ...
+ Random-number a compile time: '((rnd-1-server rnd-1-client) (rnd-1-server rnd-1-client) (rnd-1-server rnd-1-client) ...)
Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd (original)
+++ clfswm/clfswm.asd Sat Aug 23 17:16:39 2008
@@ -14,51 +14,54 @@
:components
((:file "tools")
(:file "my-html"
- :depends-on ("tools"))
+ :depends-on ("tools"))
(:file "package"
- :depends-on ("my-html" "tools" "version"))
- (:file "config"
- :depends-on ("package"))
+ :depends-on ("my-html" "tools" "version"))
(:file "keysyms"
- :depends-on ("package"))
+ :depends-on ("package"))
(:file "xlib-util"
- :depends-on ("package" "keysyms" "config"))
+ :depends-on ("package" "keysyms" "tools"))
+ (:file "config"
+ :depends-on ("package" "xlib-util"))
(:file "netwm-util"
- :depends-on ("package" "xlib-util"))
+ :depends-on ("package" "xlib-util"))
(:file "clfswm-keys"
- :depends-on ("package" "config" "xlib-util" "keysyms"))
+ :depends-on ("package" "config" "xlib-util" "keysyms"))
(:file "clfswm-autodoc"
- :depends-on ("package" "clfswm-keys" "my-html" "tools"))
+ :depends-on ("package" "clfswm-keys" "my-html" "tools" "config"))
(:file "clfswm-internal"
- :depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
+ :depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools" "config"))
(:file "clfswm"
- :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
- "clfswm-internal" "tools"))
+ :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
+ "clfswm-internal" "tools"))
(:file "version"
- :depends-on ("tools"))
+ :depends-on ("tools"))
(:file "clfswm-second-mode"
- :depends-on ("package" "clfswm" "clfswm-internal"))
+ :depends-on ("package" "clfswm" "clfswm-internal"))
+ (:file "clfswm-corner"
+ :depends-on ("package" "config" "clfswm-internal"))
(:file "clfswm-info"
- :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal" "clfswm-autodoc"))
+ :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"
+ "clfswm-autodoc" "clfswm-corner"))
(:file "clfswm-menu"
- :depends-on ("package" "clfswm-info"))
+ :depends-on ("package" "clfswm-info"))
(:file "menu-def"
- :depends-on ("clfswm-menu"))
+ :depends-on ("clfswm-menu"))
(:file "clfswm-util"
- :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu" "clfswm-autodoc"))
+ :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu" "clfswm-autodoc" "clfswm-corner"))
(:file "clfswm-query"
- :depends-on ("package" "config"))
+ :depends-on ("package" "config"))
(:file "clfswm-layout"
- :depends-on ("package" "clfswm-internal" "clfswm-util" "clfswm-info" "menu-def"))
+ :depends-on ("package" "clfswm-internal" "clfswm-util" "clfswm-info" "menu-def"))
(:file "clfswm-pack"
- :depends-on ("clfswm" "clfswm-util" "clfswm-second-mode"))
+ :depends-on ("clfswm" "clfswm-util" "clfswm-second-mode"))
(:file "clfswm-nw-hooks"
- :depends-on ("package" "clfswm-util" "clfswm-info" "clfswm-layout" "menu-def"))
+ :depends-on ("package" "clfswm-util" "clfswm-info" "clfswm-layout" "menu-def"))
(:file "bindings"
- :depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
+ :depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
(:file "bindings-second-mode"
- :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu" "menu-def"
- "clfswm-layout"))))))
+ :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu" "menu-def"
+ "clfswm-layout"))))))
Added: clfswm/doc/corner.html
==============================================================================
--- (empty file)
+++ clfswm/doc/corner.html Sat Aug 23 17:16:39 2008
@@ -0,0 +1,253 @@
+<html>
+ <head>
+ <title>
+ CLFSWM Corners
+ </title>
+ </head>
+ <body>
+ <h1>
+ <a name="top">
+ CLFSWM Corners
+ </a>
+ </h1>
+ <p>
+ Here are the actions associated to screen corners in CLFSWM:
+ </p>
+ <h3>
+ *corner-main-mode-left-button*
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Present a virtual keyboard
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Present all windows in the current frame (An expose like)
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ </table>
+ <h3>
+ *corner-main-mode-middle-button*
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the help and info window
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Close or kill the current window (ask before doing anything)
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ </table>
+ <h3>
+ *corner-main-mode-right-button*
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Hide/Unhide a terminal
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Close or kill the current window (ask before doing anything)
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Present all windows in all frames (An expose like)
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ </table>
+ <h3>
+ *corner-second-mode-left-button*
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Present all windows in the current frame (An expose like)
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ </table>
+ <h3>
+ *corner-second-mode-middle-button*
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Open the help and info window
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ </table>
+ <h3>
+ *corner-second-mode-right-button*
+ </h3>
+ <table class="ex" cellspacing="5" border="0" width="100%">
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Top-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Right:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Present all windows in all frames (An expose like)
+ </td>
+ </tr>
+ <tr>
+ <td align="left" width="1%" style="color:#ff0000" nowrap>
+ Bottom-Left:
+ </td>
+ <td style="color:#0000ff" nowrap>
+ ---
+ </td>
+ </tr>
+ </table>
+ <p>
+ <small>
+ This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-corner-doc-html-in-file or
+the produce-all-docs function from the Lisp REPL.
+ </small>
+ </p>
+ <p>
+ <small>
+ Something like this:<br>
+LISP> (in-package :clfswm)<br>
+CLFSWM> (produce-corner-doc-html-in-file "my-corner.html")<br>
+or<br> CLFSWM> (produce-all-docs)
+ </small>
+ </p>
+ </body>
+</html>
Added: clfswm/doc/corner.txt
==============================================================================
--- (empty file)
+++ clfswm/doc/corner.txt Sat Aug 23 17:16:39 2008
@@ -0,0 +1,49 @@
+Here are the actions associated to screen corners in CLFSWM:
+
+*Corner-Main-Mode-Left-Button*:
+ Top-Left: ---
+ Top-Right: Present a virtual keyboard
+ Bottom-Right: Present all windows in the current frame (An expose like)
+ Bottom-Left: ---
+
+*Corner-Main-Mode-Middle-Button*:
+ Top-Left: Open the help and info window
+ Top-Right: Close or kill the current window (ask before doing anything)
+ Bottom-Right: ---
+ Bottom-Left: ---
+
+*Corner-Main-Mode-Right-Button*:
+ Top-Left: Hide/Unhide a terminal
+ Top-Right: Close or kill the current window (ask before doing anything)
+ Bottom-Right: Present all windows in all frames (An expose like)
+ Bottom-Left: ---
+
+*Corner-Second-Mode-Left-Button*:
+ Top-Left: ---
+ Top-Right: ---
+ Bottom-Right: Present all windows in the current frame (An expose like)
+ Bottom-Left: ---
+
+*Corner-Second-Mode-Middle-Button*:
+ Top-Left: Open the help and info window
+ Top-Right: ---
+ Bottom-Right: ---
+ Bottom-Left: ---
+
+*Corner-Second-Mode-Right-Button*:
+ Top-Left: ---
+ Top-Right: ---
+ Bottom-Right: Present all windows in all frames (An expose like)
+ Bottom-Left: ---
+
+
+This documentation was produced with the CLFSWM auto-doc functions.
+To reproduce it, use the produce-menu-doc-in-file or
+the produce-all-docs function from the Lisp REPL.
+
+Something like this:
+LISP> (in-package :clfswm)
+CLFSWM> (produce-corner-doc-in-file "my-corner.txt")
+or
+CLFSWM> (produce-all-docs)
+
Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html (original)
+++ clfswm/doc/keys.html Sat Aug 23 17:16:39 2008
@@ -120,6 +120,17 @@
</tr>
<tr>
<td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Store the current child and switch to the previous one
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
Mod-1
</td>
<td align="center" nowrap>
@@ -192,6 +203,17 @@
Menu
</td>
<td style="color:#0000ff" nowrap>
+ Switch between two layouts
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+ Mod-1
+ </td>
+ <td align="center" nowrap>
+ Menu
+ </td>
+ <td style="color:#0000ff" nowrap>
Show all frames info windows until a key is release
</td>
</tr>
@@ -236,7 +258,7 @@
Escape
</td>
<td style="color:#0000ff" nowrap>
- Delete the focus window in all frames and workspaces
+ Close focus window: Delete the focus window in all frames and workspaces
</td>
</tr>
<tr>
@@ -247,7 +269,7 @@
Escape
</td>
<td style="color:#0000ff" nowrap>
- Destroy the focus window in all frames and workspaces
+ Kill focus window: Destroy the focus window in all frames and workspaces
</td>
</tr>
<tr>
@@ -431,8 +453,18 @@
</td>
<td style="color:#0000ff" nowrap>
Move and focus the current frame or focus the current window parent.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
+Or do actions on corners
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Do actions on corners
</td>
</tr>
<tr>
@@ -444,8 +476,7 @@
</td>
<td style="color:#0000ff" nowrap>
Resize and focus the current frame or focus the current window parent.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
+Or do actions on corners
</td>
</tr>
<tr>
@@ -809,6 +840,17 @@
</tr>
<tr>
<td align="right" style="color:#ff0000" nowrap>
+ Shift
+ </td>
+ <td align="center" nowrap>
+ Tab
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Store the current child and switch to the previous one
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
Mod-1
</td>
<td align="center" nowrap>
@@ -936,7 +978,7 @@
Escape
</td>
<td style="color:#0000ff" nowrap>
- Delete the focus window in all frames and workspaces
+ Close focus window: Delete the focus window in all frames and workspaces
</td>
</tr>
<tr>
@@ -947,7 +989,7 @@
Escape
</td>
<td style="color:#0000ff" nowrap>
- Destroy the focus window in all frames and workspaces
+ Kill focus window: Destroy the focus window in all frames and workspaces
</td>
</tr>
<tr>
@@ -1241,8 +1283,18 @@
</td>
<td style="color:#0000ff" nowrap>
Move and focus the current child - Create a new frame on the root window.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
+Or do corners actions
+ </td>
+ </tr>
+ <tr>
+ <td align="right" style="color:#ff0000" nowrap>
+
+ </td>
+ <td align="center" nowrap>
+ 2
+ </td>
+ <td style="color:#0000ff" nowrap>
+ Do actions on corners
</td>
</tr>
<tr>
@@ -1254,8 +1306,7 @@
</td>
<td style="color:#0000ff" nowrap>
Resize and focus the current child - Create a new frame on the root window.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
+Or do corners actions
</td>
</tr>
<tr>
Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt (original)
+++ clfswm/doc/keys.txt Sat Aug 23 17:16:39 2008
@@ -6,174 +6,176 @@
Main mode keys:
--------------
-Mod-1 F1 Open the help and info window
-Mod-1 Control Shift Home Quit clfswm
-Mod-1 Right Select the next sister frame
-Mod-1 Left Select the previous sister frame
-Mod-1 Down Select the previous level in frame
-Mod-1 Up Select the next level in frame
-Mod-1 Tab Select the next child
-Mod-1 Shift Tab Select the previous child
-Mod-1 Return Enter in the selected frame - ie make it the root frame
-Mod-1 Shift Return Leave the selected frame - ie make its parent the root frame
-Mod-1 Page_up Lower the child in the current frame
-Mod-1 Page_down Raise the child in the current frame
-Mod-1 Home Switch to the root frame
-Mod-1 Shift Home Switch and select the root frame
- Menu Show all frames info windows until a key is release
-Shift Menu Show all frames info windows
-Control Menu Show/Hide the root frame
-Mod-1 B Move the pointer to the lower right corner of the screen
-Control Shift Escape Delete the focus window in all frames and workspaces
-Mod-1 Control Shift Escape Destroy the focus window in all frames and workspaces
-Control Escape Remove the focus window in the current frame
-Shift Escape Unhide all hidden windows into the current child
-Mod-1 T Switch to editing mode
-Control Less Switch to editing mode
-Mod-1 |1| Bind or jump to a slot
-Mod-1 |2| Bind or jump to a slot
-Mod-1 |3| Bind or jump to a slot
-Mod-1 |4| Bind or jump to a slot
-Mod-1 |5| Bind or jump to a slot
-Mod-1 |6| Bind or jump to a slot
-Mod-1 |7| Bind or jump to a slot
-Mod-1 |8| Bind or jump to a slot
-Mod-1 |9| Bind or jump to a slot
-Mod-1 |0| Bind or jump to a slot
+ Mod-1 F1 Open the help and info window
+ Mod-1 Control Shift Home Quit clfswm
+ Mod-1 Right Select the next sister frame
+ Mod-1 Left Select the previous sister frame
+ Mod-1 Down Select the previous level in frame
+ Mod-1 Up Select the next level in frame
+ Mod-1 Tab Select the next child
+ Mod-1 Shift Tab Select the previous child
+ Shift Tab Store the current child and switch to the previous one
+ Mod-1 Return Enter in the selected frame - ie make it the root frame
+ Mod-1 Shift Return Leave the selected frame - ie make its parent the root frame
+ Mod-1 Page_up Lower the child in the current frame
+ Mod-1 Page_down Raise the child in the current frame
+ Mod-1 Home Switch to the root frame
+ Mod-1 Shift Home Switch and select the root frame
+ Menu Switch between two layouts
+ Mod-1 Menu Show all frames info windows until a key is release
+ Shift Menu Show all frames info windows
+ Control Menu Show/Hide the root frame
+ Mod-1 B Move the pointer to the lower right corner of the screen
+ Control Shift Escape Close focus window: Delete the focus window in all frames and workspaces
+ Mod-1 Control Shift Escape Kill focus window: Destroy the focus window in all frames and workspaces
+ Control Escape Remove the focus window in the current frame
+ Shift Escape Unhide all hidden windows into the current child
+ Mod-1 T Switch to editing mode
+ Control Less Switch to editing mode
+ Mod-1 |1| Bind or jump to a slot
+ Mod-1 |2| Bind or jump to a slot
+ Mod-1 |3| Bind or jump to a slot
+ Mod-1 |4| Bind or jump to a slot
+ Mod-1 |5| Bind or jump to a slot
+ Mod-1 |6| Bind or jump to a slot
+ Mod-1 |7| Bind or jump to a slot
+ Mod-1 |8| Bind or jump to a slot
+ Mod-1 |9| Bind or jump to a slot
+ Mod-1 |0| Bind or jump to a slot
Mouse buttons actions in main mode:
----------------------------------
- 1 Move and focus the current frame or focus the current window parent.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
- 3 Resize and focus the current frame or focus the current window parent.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
-Mod-1 1 Move and focus the current child - Create a new frame on the root window
-Mod-1 3 Resize and focus the current child - Create a new frame on the root window
-Mod-1 Control 1 Move the window under the mouse cursor to another frame
- 4 Select the next level in frame
- 5 Select the previous level in frame
-Mod-1 4 Enter in the selected frame - ie make it the root frame
-Mod-1 5 Leave the selected frame - ie make its parent the root frame
+ 1 Move and focus the current frame or focus the current window parent.
+Or do actions on corners
+ 2 Do actions on corners
+ 3 Resize and focus the current frame or focus the current window parent.
+Or do actions on corners
+ Mod-1 1 Move and focus the current child - Create a new frame on the root window
+ Mod-1 3 Resize and focus the current child - Create a new frame on the root window
+ Mod-1 Control 1 Move the window under the mouse cursor to another frame
+ 4 Select the next level in frame
+ 5 Select the previous level in frame
+ Mod-1 4 Enter in the selected frame - ie make it the root frame
+ Mod-1 5 Leave the selected frame - ie make its parent the root frame
Second mode keys:
----------------
-Mod-1 F1 Open the help and info window for the second mode
- M Open the main menu
- Less Open the main menu
-Control Less Open the main menu
- F Open the frame menu
- W Open the window menu
- N Open the action by name menu
- U Open the action by number menu
- P Open the frame pack menu
- L Open the frame fill menu
- R Open the frame resize menu
- I Identify a key
- Colon Eval a lisp form from the query input
- Exclam Run a program from the query input
- Return Leave second mode
- Escape Leave second mode
- T Tile with spaces the current frame
-Mod-1 Control Shift Home Quit clfswm
-Mod-1 Right Select the next sister frame
-Mod-1 Left Select the previous sister frame
-Mod-1 Down Select the previous level in frame
-Mod-1 Up Select the next level in frame
-Mod-1 Tab Select the next child
-Mod-1 Shift Tab Select the previous child
-Mod-1 Return Enter in the selected frame - ie make it the root frame
-Mod-1 Shift Return Leave the selected frame - ie make its parent the root frame
-Mod-1 Page_up Lower the child in the current frame
-Mod-1 Page_down Raise the child in the current frame
-Mod-1 Home Switch to the root frame
-Mod-1 Shift Home Switch and select the root frame
- Menu Show all frames info windows until a key is release
-Mod-1 B Move the pointer to the lower right corner of the screen
- O Open the next window in a new frame in the root frame
-Control O Open the next window in a new frame in the parent frame
- A Add a default frame in the current frame
-Control Shift Escape Delete the focus window in all frames and workspaces
-Mod-1 Control Shift Escape Destroy the focus window in all frames and workspaces
-Control Escape Remove the focus window in the current frame
-Shift Escape Unhide all hidden windows into the current child
-Control X Cut the current child to the selection
-Mod-1 Control X Clear the current selection
-Control C Copy the current child to the selection
-Control V Paste the selection in the current frame
-Control Shift V Paste the selection in the current frame - Do not clear the selection after paste
- Delete Remove the current child from its parent frame
- C start an xterm
- E start emacs
-Control E start an emacs for another user
- H start an xclock
-Shift Menu Show all frames info windows
-Control Menu Show/Hide the root frame
-Mod-1 |1| Bind or jump to a slot
-Mod-1 |2| Bind or jump to a slot
-Mod-1 |3| Bind or jump to a slot
-Mod-1 |4| Bind or jump to a slot
-Mod-1 |5| Bind or jump to a slot
-Mod-1 |6| Bind or jump to a slot
-Mod-1 |7| Bind or jump to a slot
-Mod-1 |8| Bind or jump to a slot
-Mod-1 |9| Bind or jump to a slot
-Mod-1 |0| Bind or jump to a slot
+ Mod-1 F1 Open the help and info window for the second mode
+ M Open the main menu
+ Less Open the main menu
+ Control Less Open the main menu
+ F Open the frame menu
+ W Open the window menu
+ N Open the action by name menu
+ U Open the action by number menu
+ P Open the frame pack menu
+ L Open the frame fill menu
+ R Open the frame resize menu
+ I Identify a key
+ Colon Eval a lisp form from the query input
+ Exclam Run a program from the query input
+ Return Leave second mode
+ Escape Leave second mode
+ T Tile with spaces the current frame
+ Mod-1 Control Shift Home Quit clfswm
+ Mod-1 Right Select the next sister frame
+ Mod-1 Left Select the previous sister frame
+ Mod-1 Down Select the previous level in frame
+ Mod-1 Up Select the next level in frame
+ Mod-1 Tab Select the next child
+ Mod-1 Shift Tab Select the previous child
+ Shift Tab Store the current child and switch to the previous one
+ Mod-1 Return Enter in the selected frame - ie make it the root frame
+ Mod-1 Shift Return Leave the selected frame - ie make its parent the root frame
+ Mod-1 Page_up Lower the child in the current frame
+ Mod-1 Page_down Raise the child in the current frame
+ Mod-1 Home Switch to the root frame
+ Mod-1 Shift Home Switch and select the root frame
+ Menu Show all frames info windows until a key is release
+ Mod-1 B Move the pointer to the lower right corner of the screen
+ O Open the next window in a new frame in the root frame
+ Control O Open the next window in a new frame in the parent frame
+ A Add a default frame in the current frame
+ Control Shift Escape Close focus window: Delete the focus window in all frames and workspaces
+ Mod-1 Control Shift Escape Kill focus window: Destroy the focus window in all frames and workspaces
+ Control Escape Remove the focus window in the current frame
+ Shift Escape Unhide all hidden windows into the current child
+ Control X Cut the current child to the selection
+ Mod-1 Control X Clear the current selection
+ Control C Copy the current child to the selection
+ Control V Paste the selection in the current frame
+ Control Shift V Paste the selection in the current frame - Do not clear the selection after paste
+ Delete Remove the current child from its parent frame
+ C start an xterm
+ E start emacs
+ Control E start an emacs for another user
+ H start an xclock
+ Shift Menu Show all frames info windows
+ Control Menu Show/Hide the root frame
+ Mod-1 |1| Bind or jump to a slot
+ Mod-1 |2| Bind or jump to a slot
+ Mod-1 |3| Bind or jump to a slot
+ Mod-1 |4| Bind or jump to a slot
+ Mod-1 |5| Bind or jump to a slot
+ Mod-1 |6| Bind or jump to a slot
+ Mod-1 |7| Bind or jump to a slot
+ Mod-1 |8| Bind or jump to a slot
+ Mod-1 |9| Bind or jump to a slot
+ Mod-1 |0| Bind or jump to a slot
Mouse buttons actions in second mode:
------------------------------------
- 1 Move and focus the current child - Create a new frame on the root window.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
- 3 Resize and focus the current child - Create a new frame on the root window.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames.
-Mod-1 1 Move and focus the current child - Create a new frame on the root window
-Mod-1 3 Resize and focus the current child - Create a new frame on the root window
-Mod-1 Control 1 Move the window under the mouse cursor to another frame
- 4 Select the next level in frame
- 5 Select the previous level in frame
-Mod-1 4 Enter in the selected frame - ie make it the root frame
-Mod-1 5 Leave the selected frame - ie make its parent the root frame
+ 1 Move and focus the current child - Create a new frame on the root window.
+Or do corners actions
+ 2 Do actions on corners
+ 3 Resize and focus the current child - Create a new frame on the root window.
+Or do corners actions
+ Mod-1 1 Move and focus the current child - Create a new frame on the root window
+ Mod-1 3 Resize and focus the current child - Create a new frame on the root window
+ Mod-1 Control 1 Move the window under the mouse cursor to another frame
+ 4 Select the next level in frame
+ 5 Select the previous level in frame
+ Mod-1 4 Enter in the selected frame - ie make it the root frame
+ Mod-1 5 Leave the selected frame - ie make its parent the root frame
Info mode keys:
--------------
- Q Leave the info mode
- Return Leave the info mode
- Escape Leave the info mode
- Twosuperior Move the pointer to the lower right corner of the screen
- Down Move one line down
- Up Move one line up
- Left Move one char left
- Right Move one char right
- Home Move to first line
- End Move to last line
- Page_down Move ten lines down
- Page_up Move ten lines up
+ Q Leave the info mode
+ Return Leave the info mode
+ Escape Leave the info mode
+ Twosuperior Move the pointer to the lower right corner of the screen
+ Down Move one line down
+ Up Move one line up
+ Left Move one char left
+ Right Move one char right
+ Home Move to first line
+ End Move to last line
+ Page_down Move ten lines down
+ Page_up Move ten lines up
Mouse buttons actions in info mode:
----------------------------------
- 1 Begin grab text
- 2 Leave the info mode
- 4 Move one line up
- 5 Move one line down
- Motion Grab text
+ 1 Begin grab text
+ 2 Leave the info mode
+ 4 Move one line up
+ 5 Move one line down
+ Motion Grab text
-This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-in-file or
-the produce-all-docs function from the Lisp REPL.
+This documentation was produced with the CLFSWM auto-doc functions.
+To reproduce it, use the produce-doc-in-file or the produce-all-docs
+function from the Lisp REPL.
Something like this:
LISP> (in-package :clfswm)
Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html (original)
+++ clfswm/doc/menu.html Sat Aug 23 17:16:39 2008
@@ -109,28 +109,44 @@
<a name="FRAME-LAYOUT-MENU"></a><a href="#FRAME-MENU">Frame-Layout-Menu</a>
</h3>
<p>
+ *: <a href="#FRAME-FAST-LAYOUT-MENU">< Frame fast layout menu ></a>
+ </p>
+ <p>
a: Maximize windows in there frame - leave frame to there size (no layout)
</p>
<p>
- b: Tile child in its frame
+ b: Tile child in its frame (vertical)
+ </p>
+ <p>
+ c: Tile child in its frame (horizontal)
</p>
<p>
- c: Tile Left: main child on left and others on right
+ d: Tile Space: tile child in its frame leaving spaces between them
</p>
<p>
- d: Tile Right: main child on right and others on left
+ e: Tile Left: main child on left and others on right
</p>
<p>
- e: Tile Top: main child on top and others on bottom
+ f: Tile Right: main child on right and others on left
</p>
<p>
- f: Tile Bottom: main child on bottom and others on top
+ g: Tile Top: main child on top and others on bottom
</p>
<p>
- g: Tile Space: tile child in its frame leaving spaces between them
+ h: Tile Bottom: main child on bottom and others on top
</p>
<p>
- h: Tile Left Space: main child on left and others on right. Leave some space on the left.
+ i: Tile Left Space: main child on left and others on right. Leave some space on the left.
+ </p>
+ <hr>
+ <h3>
+ <a name="FRAME-FAST-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Fast-Layout-Menu</a>
+ </h3>
+ <p>
+ a: Switch between two layouts
+ </p>
+ <p>
+ b: Define the two fast layouts
</p>
<hr>
<h3>
@@ -140,25 +156,28 @@
a: Maximize windows in there frame - leave frame to there size (no layout)
</p>
<p>
- b: Tile child in its frame
+ b: Tile child in its frame (vertical)
+ </p>
+ <p>
+ c: Tile child in its frame (horizontal)
</p>
<p>
- c: Tile Left: main child on left and others on right
+ d: Tile Space: tile child in its frame leaving spaces between them
</p>
<p>
- d: Tile Right: main child on right and others on left
+ e: Tile Left: main child on left and others on right
</p>
<p>
- e: Tile Top: main child on top and others on bottom
+ f: Tile Right: main child on right and others on left
</p>
<p>
- f: Tile Bottom: main child on bottom and others on top
+ g: Tile Top: main child on top and others on bottom
</p>
<p>
- g: Tile Space: tile child in its frame leaving spaces between them
+ h: Tile Bottom: main child on bottom and others on top
</p>
<p>
- h: Tile Left Space: main child on left and others on right. Leave some space on the left.
+ i: Tile Left Space: main child on left and others on right. Leave some space on the left.
</p>
<hr>
<h3>
Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt (original)
+++ clfswm/doc/menu.txt Sat Aug 23 17:16:39 2008
@@ -35,24 +35,31 @@
p: Add a placed frame in the current frame
Frame-Layout-Menu
+*: < Frame fast layout menu >
a: Maximize windows in there frame - leave frame to there size (no layout)
-b: Tile child in its frame
-c: Tile Left: main child on left and others on right
-d: Tile Right: main child on right and others on left
-e: Tile Top: main child on top and others on bottom
-f: Tile Bottom: main child on bottom and others on top
-g: Tile Space: tile child in its frame leaving spaces between them
-h: Tile Left Space: main child on left and others on right. Leave some space on the left.
+b: Tile child in its frame (vertical)
+c: Tile child in its frame (horizontal)
+d: Tile Space: tile child in its frame leaving spaces between them
+e: Tile Left: main child on left and others on right
+f: Tile Right: main child on right and others on left
+g: Tile Top: main child on top and others on bottom
+h: Tile Bottom: main child on bottom and others on top
+i: Tile Left Space: main child on left and others on right. Leave some space on the left.
+
+Frame-Fast-Layout-Menu
+a: Switch between two layouts
+b: Define the two fast layouts
Frame-Layout-Once-Menu
a: Maximize windows in there frame - leave frame to there size (no layout)
-b: Tile child in its frame
-c: Tile Left: main child on left and others on right
-d: Tile Right: main child on right and others on left
-e: Tile Top: main child on top and others on bottom
-f: Tile Bottom: main child on bottom and others on top
-g: Tile Space: tile child in its frame leaving spaces between them
-h: Tile Left Space: main child on left and others on right. Leave some space on the left.
+b: Tile child in its frame (vertical)
+c: Tile child in its frame (horizontal)
+d: Tile Space: tile child in its frame leaving spaces between them
+e: Tile Left: main child on left and others on right
+f: Tile Right: main child on right and others on left
+g: Tile Top: main child on top and others on bottom
+h: Tile Bottom: main child on bottom and others on top
+i: Tile Left Space: main child on left and others on right. Leave some space on the left.
Frame-Nw-Hook-Menu
a: Open the next window in the current frame
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Sat Aug 23 17:16:39 2008
@@ -110,6 +110,7 @@
(define-second-key ("Tab" :mod-1) 'select-next-child)
(define-second-key ("Tab" :mod-1 :shift) 'select-previous-child)
+(define-second-key (#\Tab :shift) 'switch-to-last-child)
(define-second-key ("Return" :mod-1) 'enter-frame)
(define-second-key ("Return" :mod-1 :shift) 'leave-frame)
@@ -183,7 +184,7 @@
(define-second-key ("0" :mod-1) 'bind-or-jump 10)
-;; For an azery keyboard:
+;; For a French azery keyboard:
;;(undefine-second-multi-keys (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
;; (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
;; (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1))
@@ -203,22 +204,25 @@
;;; Mouse action
(defun sm-mouse-click-to-focus-and-move (window root-x root-y)
"Move and focus the current child - Create a new frame on the root window.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames."
+Or do corners actions"
(declare (ignore window))
- (or (have-to-present-windows root-x root-y)
- (have-to-present-all-windows root-x root-y)
+ (or (do-corner-action root-x root-y *corner-second-mode-left-button*)
(mouse-focus-move/resize-generic root-x root-y #'move-frame nil)))
(defun sm-mouse-click-to-focus-and-resize (window root-x root-y)
"Resize and focus the current child - Create a new frame on the root window.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames."
+Or do corners actions"
(declare (ignore window))
- (or (have-to-present-windows root-x root-y)
- (have-to-present-all-windows root-x root-y)
+ (or (do-corner-action root-x root-y *corner-second-mode-right-button*)
(mouse-focus-move/resize-generic root-x root-y #'resize-frame nil)))
+(defun sm-mouse-middle-click (window root-x root-y)
+ "Do actions on corners"
+ (declare (ignore window))
+ (or (do-corner-action root-x root-y *corner-second-mode-middle-button*)
+ (replay-button-event)))
+
+
(defun sm-mouse-select-next-level (window root-x root-y)
@@ -264,6 +268,7 @@
(define-second-mouse (1) 'sm-mouse-click-to-focus-and-move)
+(define-second-mouse (2) 'sm-mouse-middle-click)
(define-second-mouse (3) 'sm-mouse-click-to-focus-and-resize)
(define-second-mouse (1 :mod-1) 'sm-mouse-click-to-focus-and-move-window)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Sat Aug 23 17:16:39 2008
@@ -47,6 +47,7 @@
(define-main-key ("Tab" :mod-1) 'select-next-child)
(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
+(define-main-key (#\Tab :shift) 'switch-to-last-child)
(define-main-key ("Return" :mod-1) 'enter-frame)
(define-main-key ("Return" :mod-1 :shift) 'leave-frame)
@@ -58,8 +59,9 @@
(define-main-key ("Home" :mod-1) 'switch-to-root-frame)
(define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame)
+(define-main-key ("Menu") 'fast-layout-switch)
-(define-main-key ("Menu") 'show-all-frames-info-key)
+(define-main-key ("Menu" :mod-1) 'show-all-frames-info-key)
(define-main-key ("Menu" :shift) 'show-all-frames-info)
(define-main-key ("Menu" :control) 'toggle-show-root-frame)
@@ -129,6 +131,7 @@
(define-main-mouse (1) 'mouse-click-to-focus-and-move)
+(define-main-mouse (2) 'mouse-middle-click)
(define-main-mouse (3) 'mouse-click-to-focus-and-resize)
(define-main-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window)
Modified: clfswm/src/clfswm-autodoc.lisp
==============================================================================
--- clfswm/src/clfswm-autodoc.lisp (original)
+++ clfswm/src/clfswm-autodoc.lisp Sat Aug 23 17:16:39 2008
@@ -99,7 +99,7 @@
(format stream "~2%")
(maphash #'(lambda (k v)
(when (consp k)
- (format stream "~&~20@<~{~@(~A~) ~}~> ~13@<~@(~A~)~> ~A~%"
+ (format stream "~& ~20@<~{~@(~A~) ~}~> ~13@<~@(~A~)~> ~A~%"
(state->modifiers (second k))
(remove #\# (remove #\\ (format nil "~S" (or (and (stringp (first k))
(intern (string-upcase (first k))))
@@ -107,8 +107,9 @@
(documentation (or (first v) (third v)) 'function))))
hk)
(format stream "~2&"))
- (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-in-file or
-the produce-all-docs function from the Lisp REPL.
+ (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions.
+To reproduce it, use the produce-doc-in-file or the produce-all-docs
+function from the Lisp REPL.
Something like this:
LISP> (in-package :clfswm)
@@ -221,6 +222,97 @@
+;;; Corner autodoc functions
+(defun produce-corner-doc (&optional (stream t))
+ (labels ((print-doc (corner-list)
+ (format stream "~2&~:(~A~):~%" corner-list)
+ (dolist (corner (symbol-value corner-list))
+ (format stream " ~:(~A:~) ~A~%" (first corner)
+ (if (fboundp (second corner))
+ (documentation (second corner) 'function)
+ "---")))))
+ (format stream "Here are the actions associated to screen corners in CLFSWM:")
+ (dolist (corner '(*corner-main-mode-left-button* *corner-main-mode-middle-button* *corner-main-mode-right-button*
+ *corner-second-mode-left-button* *corner-second-mode-middle-button* *corner-second-mode-right-button*))
+ (print-doc corner))
+ (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions.
+To reproduce it, use the produce-menu-doc-in-file or
+the produce-all-docs function from the Lisp REPL.
+
+Something like this:
+LISP> (in-package :clfswm)
+CLFSWM> (produce-corner-doc-in-file \"my-corner.txt\")
+or
+CLFSWM> (produce-all-docs)~2%")))
+
+
+(defun produce-corner-doc-in-file (filename)
+ (format t "Producing text corner documentation in ~S " filename)
+ (with-open-file (stream filename :direction :output
+ :if-exists :supersede :if-does-not-exist :create)
+ (produce-corner-doc stream))
+ (format t " done~%"))
+
+
+
+(defun produce-corner-doc-html (&optional (stream t))
+ (let ((corner-html nil))
+ (labels ((one-corner (corner-list)
+ (push `(h3 ,corner-list) corner-html)
+ (push `("table class=\"ex\" cellspacing=\"5\" border=\"0\" width=\"100%\""
+ ,@(loop :for corner :in (symbol-value corner-list)
+ :collect `(tr ("td align=\"left\" width=\"1%\" style=\"color:#FF0000\" nowrap"
+ ,(format nil "~:(~A~):" (first corner)))
+ ("td style=\"color:#0000FF\" nowrap"
+ ,(if (fboundp (second corner))
+ (documentation (second corner) 'function)
+ "---")))))
+ corner-html))
+ (fill-corner-list ()
+ (dolist (corner '(*corner-main-mode-left-button* *corner-main-mode-middle-button* *corner-main-mode-right-button*
+ *corner-second-mode-left-button* *corner-second-mode-middle-button* *corner-second-mode-right-button*))
+ (one-corner corner))))
+ (fill-corner-list)
+ (produce-html `(html
+ (head
+ (title "CLFSWM Corners"))
+ (body
+ (h1 ("a name=\"Top\"" "CLFSWM Corners"))
+ (p "Here are the actions associated to screen corners in CLFSWM:")
+ ,@(nreverse corner-html)
+ (p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-corner-doc-html-in-file or
+the produce-all-docs function from the Lisp REPL."))
+ (p (small "Something like this:<br>
+LISP> (in-package :clfswm)<br>
+CLFSWM> (produce-corner-doc-html-in-file \"my-corner.html\")<br>
+or<br> CLFSWM> (produce-all-docs)"))))
+ 0 stream))))
+
+
+(defun produce-corner-doc-html-in-file (filename)
+ (format t "Producing html corner documentation in ~S " filename)
+ (with-open-file (stream filename :direction :output
+ :if-exists :supersede :if-does-not-exist :create)
+ (produce-corner-doc-html stream))
+ (format t " done~%"))
+
+
+;;; Configuration variables
+(defun produce-configuration-variables (stream &optional (group t))
+ (format stream " * CLFSWM Configuration variables *~%")
+ (format stream " ------------------------------~2%")
+ (format stream " <= ~A =>~2%" (if (equal group t) "" group))
+ (with-all-internal-symbols (symbol :clfswm)
+ (when (and (is-config-p symbol)
+ (or (equal group t)
+ (string-equal group (config-group symbol))))
+ (format stream "~A = ~S~%~A~%" symbol (symbol-value symbol)
+ (config-documentation symbol))))
+ (format stream "~2& Those variables can be changed in clfswm.
+Maybe you'll need to restart clfswm to take care of new values~2%"))
+
+
+
@@ -230,5 +322,11 @@
(produce-doc-in-file "doc/keys.txt")
(produce-doc-html-in-file "doc/keys.html")
(produce-menu-doc-in-file "doc/menu.txt")
- (produce-menu-doc-html-in-file "doc/menu.html"))
+ (produce-menu-doc-html-in-file "doc/menu.html")
+ (produce-corner-doc-in-file "doc/corner.txt")
+ (produce-corner-doc-html-in-file "doc/corner.html"))
+
+
+
+
Added: clfswm/src/clfswm-corner.lisp
==============================================================================
--- (empty file)
+++ clfswm/src/clfswm-corner.lisp Sat Aug 23 17:16:39 2008
@@ -0,0 +1,161 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Corner functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program 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 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+
+(symbol-macrolet ((sw (xlib:screen-width *screen*))
+ (sh (xlib:screen-height *screen*))
+ (cs *corner-size*))
+ (defun in-corner (corner x y)
+ "Return t if (x, y) is in corner.
+Corner is one of :bottom-right :bottom-left :top-right :top-left"
+ (multiple-value-bind (xmin ymin xmax ymax)
+ (case corner
+ (:bottom-right (values (- sw cs) (- sh cs) sw sh))
+ (:bottom-left (values 0 (- sh cs) cs sh))
+ (:top-left (values 0 0 cs cs))
+ (:top-right (values (- sw cs) 0 sw cs))
+ (t (values 10 10 0 0)))
+ (and (<= xmin x xmax)
+ (<= ymin y ymax)))))
+
+
+(symbol-macrolet ((sw (xlib:screen-width *screen*))
+ (sh (xlib:screen-height *screen*))
+ (cs *corner-size*))
+ (defun find-corner (x y)
+ (cond ((and (< cs x (- sw cs)) (< cs y (- sh cs))) nil)
+ ((and (<= 0 x cs) (<= 0 y cs)) :top-left)
+ ((and (<= (- sw cs) x sw) (<= 0 y cs)) :top-right)
+ ((and (<= 0 x cs) (<= (- sh cs) y sh)) :bottom-left)
+ ((and (<= (- sw cs) x sw) (<= (- sh cs) y sh)) :bottom-right)
+ (t nil))))
+
+
+
+
+(defun do-corner-action (x y corner-list)
+ (when (frame-p *current-root*)
+ (let ((corner (find-corner x y)))
+ (when corner
+ (let ((fun (second (assoc corner corner-list))))
+ (when fun
+ (funcall fun)))))))
+
+
+
+
+
+;;;***************************************;;;
+;;; CONFIG - Corner actions definitions: ;;;
+;;;***************************************;;;
+
+(defmacro present-windows-generic ((first-restore-frame) &body body)
+ `(progn
+ (with-all-frames (,first-restore-frame frame)
+ (setf (frame-data-slot frame :old-layout) (frame-layout frame)
+ (frame-layout frame) #'tile-space-layout))
+ (show-all-children *current-root*)
+ (wait-no-key-or-button-press)
+ (wait-a-key-or-button-press )
+ (wait-no-key-or-button-press)
+ (multiple-value-bind (x y) (xlib:query-pointer *root*)
+ (let* ((child (find-child-under-mouse x y))
+ (parent (find-parent-frame child *root-frame*)))
+ (when (and child parent)
+ , at body
+ (focus-all-children child parent))))
+ (with-all-frames (,first-restore-frame frame)
+ (setf (frame-layout frame) (frame-data-slot frame :old-layout)
+ (frame-data-slot frame :old-layout) nil))
+ (show-all-children *current-root*)))
+
+(defun present-windows ()
+ "Present all windows in the current frame (An expose like)"
+ (stop-button-event)
+ (present-windows-generic (*current-root*))
+ t)
+
+(defun present-all-windows ()
+ "Present all windows in all frames (An expose like)"
+ (stop-button-event)
+ (switch-to-root-frame :show-later t)
+ (present-windows-generic (*root-frame*)
+ (hide-all-children *root-frame*)
+ (setf *current-root* parent))
+ t)
+
+(let ((vt-keyboard-on nil))
+ (defun init-virtual-keyboard ()
+ (setf vt-keyboard-on nil))
+ (defun present-virtual-keyboard ()
+ "Present a virtual keyboard"
+ (stop-button-event)
+ (do-shell (if vt-keyboard-on
+ *virtual-keyboard-kill-cmd*
+ *virtual-keyboard-cmd*))
+ (setf vt-keyboard-on (not vt-keyboard-on))
+ t))
+
+
+(let ((terminal nil))
+ (defun init-clfswm-terminal ()
+ (setf terminal nil))
+ (defun present-clfswm-terminal ()
+ "Hide/Unhide a terminal"
+ (stop-button-event)
+ (let ((found nil))
+ (dolist (win (xlib:query-tree *root*))
+ (when (string-equal (xlib:wm-name win) *clfswm-terminal-name*)
+ (setf found t)
+ (unless (equal terminal win)
+ (setf terminal win)
+ (hide-window terminal))))
+ (unless found
+ (do-shell *clfswm-terminal-cmd*)
+ (loop :with done = nil :until done
+ :do (dolist (win (xlib:query-tree *root*))
+ (when (string-equal (xlib:wm-name win) *clfswm-terminal-name*)
+ (setf terminal win
+ done t))))
+ (hide-window terminal)))
+ (cond ((window-hidden-p terminal) (unhide-window terminal)
+ (focus-window terminal)
+ (raise-window terminal))
+ (t (hide-window terminal)
+ (show-all-children nil)))
+ t))
+
+
+(defun ask-close/kill-current-window ()
+ "Close or kill the current window (ask before doing anything)"
+ (let ((window (xlib:input-focus *display*)))
+ (when (and window (not (xlib:window-equal window *no-focus-window*)))
+ (info-mode-menu `(,(format nil "Focus window: ~A" (xlib:wm-name window))
+ (#\c delete-focus-window "Close the focus window")
+ (#\k destroy-focus-window "Kill the focus window"))))))
+
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Sat Aug 23 17:16:39 2008
@@ -43,14 +43,29 @@
(defun draw-info-window (info)
- (clear-pixmap-buffer (info-window info) (info-gc info))
- (loop for line in (info-list info)
- for y from 0 do
- (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)))
+ (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))
+ (+ posx (length line))))
+ (clear-pixmap-buffer (info-window info) (info-gc info))
+ (loop for line in (info-list info)
+ for y from 0 do
+ (typecase line
+ (cons (typecase (first line)
+ (cons (let ((posx 0))
+ (dolist (l line)
+ (typecase l
+ (cons (setf posx (print-line (first l) posx y (second l))))
+ (t (setf posx (print-line l posx y)))))))
+ (t (print-line (first line) 0 y (second line)))))
+ (t (print-line line 0 y))))
+ (copy-pixmap-buffer (info-window info) (info-gc info))))
+
+
+
;;;,-----
@@ -178,90 +193,102 @@
;;;`-----
(defun info-mode (info-list &key (x 0) (y 0) (width nil) (height nil))
- "Open the info mode. Info-list is a list of info: One string per line"
- (when info-list
- (let* ((pointer-grabbed (xgrab-pointer-p))
- (keyboard-grabbed (xgrab-keyboard-p))
- (font (xlib:open-font *display* *info-font-string*))
- (ilw (xlib:max-char-width font))
- (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
- (window (xlib:create-window :parent *root*
- :x x :y y
- :width (or width
- (min (* (+ (loop for l in info-list maximize (length l)) 2) ilw)
- (- (xlib:screen-width *screen*) 2 x)))
- :height (or height
- (min (+ (* (length info-list) ilh) (/ ilh 2))
- (- (xlib:screen-height *screen*) 2 y)))
+ "Open the info mode. Info-list is a list of info: One string per line
+Or for colored output: a list (line_string color)
+Or ((1_word color) (2_word color) 3_word (4_word color)...)"
+ (labels ((compute-size (line)
+ (typecase line
+ (cons (typecase (first line)
+ (cons (let ((val 0))
+ (dolist (l line val)
+ (incf val (typecase l
+ (cons (length (first l)))
+ (t (length l)))))))
+ (t (length (first line)))))
+ (t (length line)))))
+ (when info-list
+ (let* ((pointer-grabbed (xgrab-pointer-p))
+ (keyboard-grabbed (xgrab-keyboard-p))
+ (font (xlib:open-font *display* *info-font-string*))
+ (ilw (xlib:max-char-width font))
+ (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
+ (window (xlib:create-window :parent *root*
+ :x x :y y
+ :width (or width
+ (min (* (+ (loop for l in info-list maximize (compute-size l)) 2) ilw)
+ (- (xlib:screen-width *screen*) 2 x)))
+ :height (or height
+ (min (+ (* (length info-list) ilh) (/ ilh 2))
+ (- (xlib:screen-height *screen*) 2 y)))
+ :background (get-color *info-background*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :border-width 1
+ :border (get-color *info-border*)
+ :event-mask '(:exposure)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *info-foreground*)
:background (get-color *info-background*)
- :colormap (xlib:screen-default-colormap *screen*)
- :border-width 1
- :border (get-color *info-border*)
- :event-mask '(:exposure)))
- (gc (xlib:create-gcontext :drawable window
- :foreground (get-color *info-foreground*)
- :background (get-color *info-background*)
- :font font
- :line-style :solid))
- (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
- :font font :ilw ilw :ilh ilh
- :max-x (* (loop for l in info-list maximize (length l)) ilw)
- :max-y (* (length info-list) ilh))))
- (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
- (declare (ignore event-slots root))
- (funcall-key-from-code *info-keys* code state info))
- (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
- (declare (ignore event-slots))
- (unless (compress-motion-notify)
- (funcall-button-from-code *info-mouse* 'motion 0 window root-x root-y *fun-press* (list info))))
- (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
- (declare (ignore event-slots))
- (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
- (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
- (declare (ignore event-slots))
- (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info)))
- (info-handle-unmap-notify (&rest event-slots)
- (apply #'handle-unmap-notify event-slots)
- (draw-info-window info))
- (info-handle-destroy-notify (&rest event-slots)
- (apply #'handle-destroy-notify event-slots)
- (draw-info-window info))
- (handle-events (&rest event-slots &key display event-key &allow-other-keys)
- (declare (ignore display))
- (case event-key
- (:key-press (apply #'handle-key event-slots) t)
- (:button-press (apply #'handle-button-press event-slots) t)
- (:button-release (apply #'handle-button-release event-slots) t)
- (:motion-notify (apply #'handle-motion-notify event-slots) t)
- (:map-request nil)
- (:unmap-notify (apply #'info-handle-unmap-notify event-slots) t)
- (:destroy-notify (apply #'info-handle-destroy-notify event-slots) t)
- (:mapping-notify nil)
- (:property-notify nil)
- (:create-notify nil)
- (:enter-notify nil)
- (:exposure (draw-info-window info)))
- t))
- (xlib:map-window window)
- (draw-info-window info)
- (xgrab-pointer *root* 68 69)
- (unless keyboard-grabbed
- (xgrab-keyboard *root*))
- (unwind-protect
- (catch 'exit-info-loop
- (loop
- (xlib:display-finish-output *display*)
- (xlib:process-event *display* :handler #'handle-events)))
- (if pointer-grabbed
- (xgrab-pointer *root* 66 67)
- (xungrab-pointer))
+ :font font
+ :line-style :solid))
+ (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
+ :font font :ilw ilw :ilh ilh
+ :max-x (* (loop for l in info-list maximize (compute-size l)) ilw)
+ :max-y (* (length info-list) ilh))))
+ (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
+ (declare (ignore event-slots root))
+ (funcall-key-from-code *info-keys* code state info))
+ (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (compress-motion-notify)
+ (funcall-button-from-code *info-mouse* 'motion 0 window root-x root-y *fun-press* (list info))))
+ (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
+ (declare (ignore event-slots))
+ (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
+ (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
+ (declare (ignore event-slots))
+ (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info)))
+ (info-handle-unmap-notify (&rest event-slots)
+ (apply #'handle-unmap-notify event-slots)
+ (draw-info-window info))
+ (info-handle-destroy-notify (&rest event-slots)
+ (apply #'handle-destroy-notify event-slots)
+ (draw-info-window info))
+ (handle-events (&rest event-slots &key display event-key &allow-other-keys)
+ (declare (ignore display))
+ (case event-key
+ (:key-press (apply #'handle-key event-slots) t)
+ (:button-press (apply #'handle-button-press event-slots) t)
+ (:button-release (apply #'handle-button-release event-slots) t)
+ (:motion-notify (apply #'handle-motion-notify event-slots) t)
+ (:map-request nil)
+ (:unmap-notify (apply #'info-handle-unmap-notify event-slots) t)
+ (:destroy-notify (apply #'info-handle-destroy-notify event-slots) t)
+ (:mapping-notify nil)
+ (:property-notify nil)
+ (:create-notify nil)
+ (:enter-notify nil)
+ (:exposure (draw-info-window info)))
+ t))
+ (xlib:map-window window)
+ (draw-info-window info)
+ (xgrab-pointer *root* 68 69)
(unless keyboard-grabbed
- (xungrab-keyboard))
- (xlib:free-gcontext gc)
- (xlib:destroy-window window)
- (xlib:close-font font)
- (display-all-frame-info)
- (wait-no-key-or-button-press))))))
+ (xgrab-keyboard *root*))
+ (unwind-protect
+ (catch 'exit-info-loop
+ (loop
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-events)))
+ (if pointer-grabbed
+ (xgrab-pointer *root* 66 67)
+ (xungrab-pointer))
+ (unless keyboard-grabbed
+ (xungrab-keyboard))
+ (xlib:free-gcontext gc)
+ (xlib:destroy-window window)
+ (xlib:close-font font)
+ (display-all-frame-info)
+ (wait-no-key-or-button-press)))))))
@@ -273,30 +300,39 @@
Item-list is: '((key function) separator (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)"
+Separator is a string or a symbol (all but a list)
+Function can be a function or a list (function color) for colored output"
(let ((info-list nil)
(action nil))
- (dolist (item item-list)
- (typecase item
- (cons (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
- (push (format nil "~@(~A~): ~A" key (or explicit-doc
- (documentation function 'function)))
- info-list)
- (define-info-key-fun (list key 0)
- (lambda (&optional args)
- (declare (ignore args))
- (setf action function)
- (throw 'exit-info-loop nil)))))
- (t (push (format nil "-=- ~A -=-" item) info-list))))
- (info-mode (nreverse info-list) :x x :y y :width width :height height)
- (dolist (item item-list)
- (when (consp item)
- (let ((key (first item)))
- (undefine-info-key-fun (list key 0)))))
- (typecase action
- (function (funcall action))
- (symbol (when (fboundp action)
- (funcall action))))))
+ (labels ((define-key (key function)
+ (define-info-key-fun (list key 0)
+ (lambda (&optional args)
+ (declare (ignore args))
+ (setf action function)
+ (throw 'exit-info-loop nil)))))
+ (dolist (item item-list)
+ (typecase item
+ (cons (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
+ (typecase function
+ (cons (push (list (list (format nil "~A" key) *menu-color-menu-key*)
+ (list (format nil ": ~A" (or explicit-doc (documentation (first function) 'function)))
+ (second function)))
+ info-list)
+ (define-key key (first function)))
+ (t (push (list (list (format nil "~A" key) *menu-color-key*)
+ (format nil ": ~A" (or explicit-doc (documentation function 'function))))
+ info-list)
+ (define-key key function)))))
+ (t (push (list (format nil "-=- ~A -=-" item) *menu-color-comment*) info-list))))
+ (info-mode (nreverse info-list) :x x :y y :width width :height height)
+ (dolist (item item-list)
+ (when (consp item)
+ (let ((key (first item)))
+ (undefine-info-key-fun (list key 0)))))
+ (typecase action
+ (function (funcall action))
+ (symbol (when (fboundp action)
+ (funcall action)))))))
@@ -306,27 +342,31 @@
"Produce a key menu based on list item"
(loop for l in list
for i from 0
- collect (list (code-char (+ (char-code #\a) i)) l)))
+ collect (list (number->char i) l)))
;;;,-----
;;;| CONFIG - Info mode functions
;;;`-----
-(defun append-space (string)
- "Append spaces before Newline on each line"
- (with-output-to-string (stream)
- (loop for c across string do
- (when (equal c #\Newline)
- (princ " " stream))
- (princ c stream))))
-
+(defun key-binding-colorize-line (list)
+ (loop :for line :in list
+ :collect (cond ((search "* CLFSWM Keys *" line) (list line *info-color-title*))
+ ((search "---" line) (list line *info-color-underline*))
+ ((begin-with-2-spaces line)
+ (list (list (subseq line 0 22) *info-color-second*)
+ (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"
- (info-mode (split-string (append-space (with-output-to-string (stream)
- (produce-doc hash-table-key
- stream)))
- #\Newline)))
+ (info-mode (key-binding-colorize-line
+ (split-string (append-newline-space
+ (with-output-to-string (stream)
+ (produce-doc hash-table-key
+ stream)))
+ #\Newline))))
(defun show-global-key-binding ()
@@ -343,41 +383,105 @@
(show-key-binding *second-keys* *second-mouse*))
+
+(defun corner-help-colorize-line (list)
+ (loop :for line :in list
+ :collect (cond ((search "CLFSWM:" line) (list line *info-color-title*))
+ ((search "*:" line) (list line *info-color-underline*))
+ ((begin-with-2-spaces line)
+ (let ((pos (position #\: line)))
+ (if pos
+ (list (list (subseq line 0 (1+ pos)) *info-color-first*)
+ (subseq line (1+ pos)))
+ line)))
+ (t line))))
+
+(defun show-corner-help ()
+ "Help on clfswm corner"
+ (info-mode (corner-help-colorize-line
+ (split-string (append-newline-space
+ (with-output-to-string (stream)
+ (produce-corner-doc stream)))
+ #\Newline))))
+
+
+(defun configuration-variable-colorize-line (list)
+ (loop :for line :in list
+ :collect (cond ((search "CLFSWM " line) (list line *info-color-title*))
+ ((search "* =" line)
+ (let ((pos (position #\= line)))
+ (list (list (subseq line 0 (1+ pos)) *info-color-first*)
+ (list (subseq line (1+ pos)) *info-color-second*))))
+ ((search "<=" line) (list line *info-color-underline*))
+ (t line))))
+
+
+(defun show-config-variable ()
+ "Show all configurable variables"
+ (let ((all-groups nil)
+ (result nil))
+ (with-all-internal-symbols (symbol :clfswm)
+ (when (is-config-p symbol)
+ (pushnew (config-group symbol) all-groups :test #'string-equal)))
+ (labels ((rec ()
+ (setf result nil)
+ (info-mode-menu (loop :for group :in all-groups
+ :for i :from 0
+ :collect (list (number->char i)
+ (let ((group group))
+ (lambda ()
+ (setf result group)))
+ group)))
+ (when result
+ (info-mode (configuration-variable-colorize-line
+ (split-string (append-newline-space
+ (with-output-to-string (stream)
+ (produce-configuration-variables stream result)))
+ #\Newline)))
+ (rec))))
+ (rec))))
+
+
+
+
(defun show-date ()
"Show the current time and date"
- (info-mode (list (date-string))))
+ (info-mode (list (list `("Current date:" ,*menu-color-comment*) (date-string)))))
-(defun info-on-shell (program)
+(defun info-on-shell (msg program)
(let ((lines (do-shell program nil t)))
- (info-mode (loop for line = (read-line lines nil nil)
- while line
- collect line))))
+ (info-mode (append (list (list msg *menu-color-comment*))
+ (loop for line = (read-line lines nil nil)
+ while line
+ collect line)))))
(defun show-cpu-proc ()
"Show current processes sorted by CPU usage"
- (info-on-shell "ps --cols=1000 --sort='-%cpu,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
+ (info-on-shell "Current processes sorted by CPU usage:"
+ "ps --cols=1000 --sort='-%cpu,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
(defun show-mem-proc ()
"Show current processes sorted by memory usage"
- (info-on-shell "ps --cols=1000 --sort='-vsz,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
+ (info-on-shell "Current processes sorted by MEMORY usage:"
+ "ps --cols=1000 --sort='-vsz,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
(defun show-xmms-status ()
"Show the current xmms status"
- (info-on-shell "xmms-shell -e status"))
+ (info-on-shell "XMMS status:" "xmms-shell -e status"))
(defun show-xmms-playlist ()
"Show the current xmms playlist"
- (info-on-shell "xmms-shell -e list"))
+ (info-on-shell "XMMS Playlist:" "xmms-shell -e list"))
(defun xmms-info-menu ()
- "Open the xmms menu"
+ "< Open the xmms menu >"
(info-mode-menu '((#\s show-xmms-status)
(#\l show-xmms-playlist))))
@@ -385,14 +489,14 @@
(defun show-cd-info ()
"Show the current CD track"
- (info-on-shell "pcd i"))
+ (info-on-shell "Current CD track:" "pcd i"))
(defun show-cd-playlist ()
"Show the current CD playlist"
- (info-on-shell "pcd mi"))
+ (info-on-shell "Current CD playlist:" "pcd mi"))
(defun info-on-cd-menu ()
- "Open the CD info menu"
+ "< Open the CD info menu >"
(info-mode-menu '((#\i show-cd-info)
(#\l show-cd-playlist))))
@@ -401,28 +505,33 @@
"Show the current CLFSWM version"
(info-mode (list *version*)))
+
(defun help-on-clfswm ()
"Open the help and info window"
- (info-mode-menu '((#\h show-global-key-binding)
+ (info-mode-menu `((#\h show-global-key-binding)
(#\b show-main-mode-key-binding)
- (#\t show-date)
- (#\c show-cpu-proc)
+ (#\c show-corner-help)
+ (#\g show-config-variable)
+ (#\d show-date)
+ (#\p show-cpu-proc)
(#\m show-mem-proc)
- (#\x xmms-info-menu)
+ (#\x (xmms-info-menu ,*menu-color-submenu*))
(#\v show-version)
- (#\d info-on-cd-menu))))
+ (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
(defun help-on-second-mode ()
"Open the help and info window for the second mode"
- (info-mode-menu '((#\h show-global-key-binding)
+ (info-mode-menu `((#\h show-global-key-binding)
(#\b show-second-mode-key-binding)
- (#\t show-date)
- (#\c show-cpu-proc)
+ (#\c show-corner-help)
+ (#\g show-config-variable)
+ (#\d show-date)
+ (#\p show-cpu-proc)
(#\m show-mem-proc)
- (#\x xmms-info-menu)
+ (#\x (xmms-info-menu ,*menu-color-submenu*))
(#\v show-version)
- (#\d info-on-cd-menu))))
+ (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Sat Aug 23 17:16:39 2008
@@ -64,9 +64,6 @@
-
-
-
(defgeneric frame-p (frame))
(defmethod frame-p ((frame frame))
(declare (ignore frame))
@@ -121,6 +118,12 @@
t))
+(defun never-managed-window-p (window)
+ (dolist (type *never-managed-window-list*)
+ (when (string-equal (funcall (first type) window) (second type))
+ (return t))))
+
+
@@ -889,8 +892,9 @@
(:transient 1)
(t 1)))
(grab-all-buttons window)
- (unless (do-all-frames-nw-hook window)
- (call-hook *default-nw-hook* (list *root-frame* window)))
+ (unless (never-managed-window-p window)
+ (unless (do-all-frames-nw-hook window)
+ (call-hook *default-nw-hook* (list *root-frame* window))))
(netwm-add-in-client-list window)))
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Sat Aug 23 17:16:39 2008
@@ -91,6 +91,50 @@
+(defun fast-layout-switch ()
+ "Switch between two layouts"
+ (when (frame-p *current-child*)
+ (with-slots (layout) *current-child*
+ (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
+ (first-layout (symbol-function (first layout-list)))
+ (second-layout (symbol-function (second layout-list))))
+ (setf layout (if (eql layout first-layout)
+ second-layout
+ first-layout))
+ (leave-second-mode)))))
+
+(defun define-fast-layout-switch ()
+ "Define the two fast layouts"
+ (when (frame-p *current-child*)
+ (labels ((ask-new-layout (msg)
+ (let* ((new-layout nil)
+ (menu-list (loop :for item :in (rest (menu-item (find-menu 'frame-layout-menu)))
+ :for i :from 0
+ :as fun-name = (intern (subseq (format nil "~A" (menu-item-value item)) 4) :clfswm)
+ :as fun = (let ((nl fun-name))
+ (lambda () (setf new-layout nl)))
+ :collect (list (code-char (+ (char-code #\a) i)) fun (documentation fun-name 'function)))))
+ (push msg menu-list)
+ (info-mode-menu menu-list)
+ new-layout)))
+ (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
+ (first-layout (first layout-list))
+ (second-layout (second layout-list)))
+ (awhen (ask-new-layout (format nil "Please, choose the first layout (last: ~:(~A~))" first-layout))
+ (setf first-layout it))
+ (awhen (ask-new-layout (format nil "Please, choose the second layout (last: ~:(~A~))" second-layout))
+ (setf second-layout it))
+ (setf (frame-data-slot *current-child* :fast-layout)
+ (list first-layout second-layout))))
+ (leave-second-mode)))
+
+
+(add-sub-menu 'frame-layout-menu #\* 'frame-fast-layout-menu "Frame fast layout menu")
+(add-menu-key 'frame-fast-layout-menu "a" 'fast-layout-switch)
+(add-menu-key 'frame-fast-layout-menu "b" 'define-fast-layout-switch)
+
+
+
;;; No layout
(defgeneric no-layout (child parent)
(:documentation "Maximize windows in there frame - leave frame to there size (no layout)"))
@@ -121,7 +165,7 @@
;;; Tile layout
(defgeneric tile-layout (child parent)
- (:documentation "Tile child in its frame"))
+ (:documentation "Tile child in its frame (vertical)"))
(defmethod tile-layout (child parent)
(let* ((managed-children (get-managed-child parent))
@@ -136,17 +180,66 @@
(round (- dy 2)))))
(defun set-tile-layout ()
- "Tile child in its frame"
+ "Tile child in its frame (vertical)"
(set-layout #'tile-layout))
(register-layout 'set-tile-layout)
-;;; Tile Left
-(defgeneric tile-left-layout (child parent)
- (:documentation "Tile Left: main child on left and others on right"))
+(defgeneric tile-horizontal-layout (child parent)
+ (:documentation "Tile child in its frame (horizontal)"))
+
+(defmethod tile-horizontal-layout (child parent)
+ (let* ((managed-children (get-managed-child parent))
+ (pos (position child managed-children))
+ (len (length managed-children))
+ (n (ceiling (sqrt len)))
+ (dx (/ (frame-rw parent) (ceiling (/ len n))))
+ (dy (/ (frame-rh parent) n)))
+ (values (round (+ (frame-rx parent) (truncate (* (truncate (/ pos n)) dx)) 1))
+ (round (+ (frame-ry parent) (truncate (* (mod pos n) dy)) 1))
+ (round (- dx 2))
+ (round (- dy 2)))))
+
+(defun set-tile-horizontal-layout ()
+ " Tile child in its frame (horizontal)"
+ (set-layout #'tile-horizontal-layout))
+
+(register-layout 'set-tile-horizontal-layout)
+
+
+
+
+
+;;; Space layout
+(defun tile-space-layout (child parent)
+ "Tile Space: tile child in its frame leaving spaces between them"
+ (with-slots (rx ry rw rh) parent
+ (let* ((managed-children (get-managed-child parent))
+ (pos (position child managed-children))
+ (len (length managed-children))
+ (n (ceiling (sqrt len)))
+ (dx (/ rw n))
+ (dy (/ rh (ceiling (/ len n))))
+ (size (or (frame-data-slot parent :tile-space-size) 0.1)))
+ (when (> size 0.5) (setf size 0.45))
+ (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
+ (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
+ (round (- dx (* dx size 2) 2))
+ (round (- dy (* dy size 2) 2))))))
+
+(defun set-tile-space-layout ()
+ "Tile Space: tile child in its frame leaving spaces between them"
+ (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
+ (set-layout #'tile-space-layout))
+
+(register-layout 'set-tile-space-layout)
-(defmethod tile-left-layout (child parent)
+
+
+;;; Tile Left
+(defun tile-left-layout (child parent)
+ "Tile Left: main child on left and others on right"
(with-slots (rx ry rw rh) parent
(let* ((managed-children (get-managed-child parent))
(pos (position child managed-children))
@@ -176,10 +269,8 @@
;;; Tile right
-(defgeneric tile-right-layout (child parent)
- (:documentation "Tile Right: main child on right and others on left"))
-
-(defmethod tile-right-layout (child parent)
+(defun tile-right-layout (child parent)
+ "Tile Right: main child on right and others on left"
(with-slots (rx ry rw rh) parent
(let* ((managed-children (get-managed-child parent))
(pos (position child managed-children))
@@ -200,7 +291,7 @@
(defun set-tile-right-layout ()
- "Tile Right: main child on right and others on left"
+ " Tile Right: main child on right and others on left"
(layout-ask-size "Tile size in percent (%)" :tile-size)
(set-layout #'tile-right-layout))
@@ -211,10 +302,8 @@
;;; Tile Top
-(defgeneric tile-top-layout (child parent)
- (:documentation "Tile Top: main child on top and others on bottom"))
-
-(defmethod tile-top-layout (child parent)
+(defun tile-top-layout (child parent)
+ "Tile Top: main child on top and others on bottom"
(with-slots (rx ry rw rh) parent
(let* ((managed-children (get-managed-child parent))
(pos (position child managed-children))
@@ -235,7 +324,7 @@
(defun set-tile-top-layout ()
- "Tile Top: main child on top and others on bottom"
+ " Tile Top: main child on top and others on bottom"
(layout-ask-size "Tile size in percent (%)" :tile-size)
(set-layout #'tile-top-layout))
@@ -244,10 +333,8 @@
;;; Tile Bottom
-(defgeneric tile-bottom-layout (child parent)
- (:documentation "Tile Bottom: main child on bottom and others on top"))
-
-(defmethod tile-bottom-layout (child parent)
+(defun tile-bottom-layout (child parent)
+ "Tile Bottom: main child on bottom and others on top"
(with-slots (rx ry rw rh) parent
(let* ((managed-children (get-managed-child parent))
(pos (position child managed-children))
@@ -269,7 +356,7 @@
(defun set-tile-bottom-layout ()
- "Tile Bottom: main child on bottom and others on top"
+ " Tile Bottom: main child on bottom and others on top"
(layout-ask-size "Tile size in percent (%)" :tile-size)
(set-layout #'tile-bottom-layout))
@@ -280,37 +367,6 @@
-;;; Space layout
-(defgeneric tile-space-layout (child parent)
- (:documentation "Tile Space: tile child in its frame leaving spaces between them"))
-
-(defmethod tile-space-layout (child parent)
- (with-slots (rx ry rw rh) parent
- (let* ((managed-children (get-managed-child parent))
- (pos (position child managed-children))
- (len (length managed-children))
- (n (ceiling (sqrt len)))
- (dx (/ rw n))
- (dy (/ rh (ceiling (/ len n))))
- (size (or (frame-data-slot parent :tile-space-size) 0.1)))
- (when (> size 0.5) (setf size 0.45))
- (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
- (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
- (round (- dx (* dx size 2) 2))
- (round (- dy (* dy size 2) 2))))))
-
-(defun set-tile-space-layout ()
- "Tile Space: tile child in its frame leaving spaces between them"
- (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
- (set-layout #'tile-space-layout))
-
-(register-layout 'set-tile-space-layout)
-
-
-
-
-
-
;;; Left and space layout: like left layout but leave a space on the left
@@ -320,11 +376,8 @@
(setf (frame-data-slot *current-child* slot) new-space))))
-(defgeneric tile-left-space-layout (child parent)
- (:documentation "Tile Left Space: main child on left and others on right. Leave some space on the left."))
-
-;;; TODO: if only one window -> max in its frame
-(defmethod tile-left-space-layout (child parent)
+(defun tile-left-space-layout (child parent)
+ "Tile Left Space: main child on left and others on right. Leave some space on the left."
(with-slots (rx ry rw rh) parent
(let* ((managed-children (get-managed-child parent))
(pos (position child managed-children))
Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp (original)
+++ clfswm/src/clfswm-menu.lisp Sat Aug 23 17:16:39 2008
@@ -102,9 +102,11 @@
(action nil))
(dolist (item (menu-item menu))
(let ((value (menu-item-value item)))
- (push (format nil "~A: ~A" (menu-item-key item) (typecase value
- (menu (format nil "< ~A >" (menu-doc value)))
- (t (documentation value 'function))))
+ (push (typecase value
+ (menu (list (list (format nil "~A" (menu-item-key item)) *menu-color-menu-key*)
+ (list (format nil ": < ~A >" (menu-doc value)) *menu-color-submenu*)))
+ (t (list (list (format nil "~A" (menu-item-key item)) *menu-color-key*)
+ (format nil ": ~A" (documentation value 'function)))))
info-list)
(define-info-key-fun (list (menu-item-key item) 0)
(lambda (&optional args)
Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp (original)
+++ clfswm/src/clfswm-nw-hooks.lisp Sat Aug 23 17:16:39 2008
@@ -49,7 +49,6 @@
(leave-second-mode)))
(defun register-nw-hook (hook)
- (setf *nw-hook-list* (append *nw-hook-list* (list hook)))
(add-menu-key 'frame-nw-hook-menu (code-char *nw-hook-current-key*) hook)
(incf *nw-hook-current-key*))
@@ -80,12 +79,10 @@
(defun default-frame-nw-hook (frame window)
"Open the next window in the current frame"
(declare (ignore frame))
- (unless (or (string-equal (xlib:get-wm-class window) "ROX-Pinboard")
- (string-equal (xlib:get-wm-class window) "xvkbd"))
- (leave-if-not-frame *current-child*)
- (when (frame-p *current-child*)
- (pushnew window (frame-child *current-child*)))
- (default-window-placement *current-child* window)))
+ (leave-if-not-frame *current-child*)
+ (when (frame-p *current-child*)
+ (pushnew window (frame-child *current-child*)))
+ (default-window-placement *current-child* window))
(defun set-default-frame-nw-hook ()
"Open the next window in the current frame"
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Sat Aug 23 17:16:39 2008
@@ -25,6 +25,8 @@
(in-package :clfswm)
+(defparameter *in-second-mode* nil)
+
(defparameter *sm-window* nil)
(defparameter *sm-font* nil)
(defparameter *sm-gc* nil)
@@ -127,17 +129,17 @@
;;; CONFIG: Second mode hooks
-(setf *sm-button-press-hook* #'sm-handle-button-press
- *sm-button-release-hook* #'sm-handle-button-release
- *sm-motion-notify-hook* #'sm-handle-motion-notify
- *sm-key-press-hook* #'sm-handle-key-press
- *sm-configure-request-hook* #'sm-handle-configure-request
- *sm-configure-notify-hook* #'sm-handle-configure-notify
- *sm-destroy-notify-hook* #'sm-handle-destroy-notify
- *sm-enter-notify-hook* #'sm-handle-enter-notify
- *sm-exposure-hook* #'sm-handle-exposure
- *sm-map-request-hook* #'sm-handle-map-request
- *sm-unmap-notify-hook* #'sm-handle-unmap-notify)
+(setf *sm-button-press-hook* 'sm-handle-button-press
+ *sm-button-release-hook* 'sm-handle-button-release
+ *sm-motion-notify-hook* 'sm-handle-motion-notify
+ *sm-key-press-hook* 'sm-handle-key-press
+ *sm-configure-request-hook* 'sm-handle-configure-request
+ *sm-configure-notify-hook* 'sm-handle-configure-notify
+ *sm-destroy-notify-hook* 'sm-handle-destroy-notify
+ *sm-enter-notify-hook* 'sm-handle-enter-notify
+ *sm-exposure-hook* 'sm-handle-exposure
+ *sm-map-request-hook* 'sm-handle-map-request
+ *sm-unmap-notify-hook* 'sm-handle-unmap-notify)
@@ -170,7 +172,8 @@
(defun second-key-mode ()
"Switch to editing mode"
;;(dbg "Second key ignore" c)))))
- (setf *sm-window* (xlib:create-window :parent *root*
+ (setf *in-second-mode* t
+ *sm-window* (xlib:create-window :parent *root*
:x (truncate (/ (- (xlib:screen-width *screen*) *sm-width*) 2))
:y 0
:width *sm-width* :height *sm-height*
@@ -209,11 +212,15 @@
(wait-no-key-or-button-press)
(when *second-mode-program*
(do-shell *second-mode-program*)
- (setf *second-mode-program* nil)))
+ (setf *second-mode-program* nil))
+ (setf *in-second-mode* nil))
(defun leave-second-mode ()
"Leave second mode"
- (banish-pointer)
- (throw 'exit-second-loop nil))
+ (cond (*in-second-mode*
+ (banish-pointer)
+ (throw 'exit-second-loop nil))
+ (t (show-all-children))))
+
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sat Aug 23 17:16:39 2008
@@ -77,21 +77,21 @@
(defun delete-focus-window ()
- "Delete the focus window in all frames and workspaces"
+ "Close focus window: Delete the focus window in all frames and workspaces"
(let ((window (xlib:input-focus *display*)))
(when (and window (not (xlib:window-equal window *no-focus-window*)))
- (setf *current-child* *current-root*)
- (remove-child-in-all-frames window)
+ (when (equal window *current-child*)
+ (setf *current-child* *current-root*))
(send-client-message window :WM_PROTOCOLS
(xlib:intern-atom *display* "WM_DELETE_WINDOW"))
(show-all-children))))
(defun destroy-focus-window ()
- "Destroy the focus window in all frames and workspaces"
+ "Kill focus window: Destroy the focus window in all frames and workspaces"
(let ((window (xlib:input-focus *display*)))
(when (and window (not (xlib:window-equal window *no-focus-window*)))
- (setf *current-child* *current-root*)
- (remove-child-in-all-frames window)
+ (when (equal window *current-child*)
+ (setf *current-child* *current-root*))
(xlib:kill-client *display* (xlib:window-id window))
(show-all-children))))
@@ -480,57 +480,6 @@
-;;; Mouse utilities
-(defmacro present-windows-generic ((first-restore-frame) &body body)
- `(progn
- (with-all-frames (,first-restore-frame frame)
- (setf (frame-data-slot frame :old-layout) (frame-layout frame)
- (frame-layout frame) #'tile-space-layout))
- (show-all-children *current-root*)
- (wait-no-key-or-button-press)
- (wait-a-key-or-button-press )
- (wait-no-key-or-button-press)
- (multiple-value-bind (x y) (xlib:query-pointer *root*)
- (let* ((child (find-child-under-mouse x y))
- (parent (find-parent-frame child *root-frame*)))
- (when (and child parent)
- , at body
- (focus-all-children child parent))))
- (with-all-frames (,first-restore-frame frame)
- (setf (frame-layout frame) (frame-data-slot frame :old-layout)
- (frame-data-slot frame :old-layout) nil))
- (show-all-children *current-root*)))
-
-(defun have-to-present-windows (root-x root-y)
- (when (and (frame-p *current-root*)
- (in-corner *present-windows-corner* root-x root-y))
- (stop-button-event)
- (present-windows-generic (*current-root*))
- t))
-
-(defun have-to-present-all-windows (root-x root-y)
- (when (and (frame-p *current-root*)
- (in-corner *present-all-windows-corner* root-x root-y))
- (stop-button-event)
- (switch-to-root-frame :show-later t)
- (present-windows-generic (*root-frame*)
- (hide-all-children *root-frame*)
- (setf *current-root* parent))
- t))
-
-(let ((vt-keyboard-on nil))
- (defun have-to-present-virtual-keyboard (root-x root-y)
- (when (and (frame-p *current-root*)
- (in-corner *present-virtual-keyboard-corner* root-x root-y))
- (stop-button-event)
- (do-shell (if vt-keyboard-on
- *virtual-keyboard-kill-cmd*
- *virtual-keyboard-cmd*))
- (setf vt-keyboard-on (not vt-keyboard-on))
- t)))
-
-
-
(defun move-frame (frame parent orig-x orig-y)
(when (and frame parent)
@@ -585,22 +534,22 @@
(defun mouse-click-to-focus-and-move (window root-x root-y)
"Move and focus the current frame or focus the current window parent.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames."
- (or (have-to-present-windows root-x root-y)
- (have-to-present-all-windows root-x root-y)
- (have-to-present-virtual-keyboard root-x root-y)
+Or do actions on corners"
+ (or (do-corner-action root-x root-y *corner-main-mode-left-button*)
(mouse-click-to-focus-generic window root-x root-y #'move-frame)))
(defun mouse-click-to-focus-and-resize (window root-x root-y)
"Resize and focus the current frame or focus the current window parent.
-On *present-windows-corner*: Present windows in the current root.
-On *present-all-windows-corner*: Present all windows in all frames."
- (or (have-to-present-windows root-x root-y)
- (have-to-present-all-windows root-x root-y)
- (have-to-present-virtual-keyboard root-x root-y)
+Or do actions on corners"
+ (or (do-corner-action root-x root-y *corner-main-mode-right-button*)
(mouse-click-to-focus-generic window root-x root-y #'resize-frame)))
+(defun mouse-middle-click (window root-x root-y)
+ "Do actions on corners"
+ (declare (ignore window))
+ (or (do-corner-action root-x root-y *corner-main-mode-middle-button*)
+ (replay-button-event)))
+
@@ -1097,3 +1046,23 @@
+(let ((last-child nil))
+ (defun init-last-child ()
+ (setf last-child nil))
+ (defun switch-to-last-child ()
+ "Store the current child and switch to the previous one"
+ (let ((current-child *current-child*))
+ (when last-child
+ (hide-all *current-root*)
+ (setf *current-root* last-child
+ *current-child* *current-root*)
+ (focus-all-children *current-child* *current-child*)
+ (show-all-children *current-root*))
+ (setf last-child current-child))))
+
+
+
+
+
+
+
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Sat Aug 23 17:16:39 2008
@@ -139,18 +139,18 @@
;;; CONFIG: Main mode hooks
-(setf *key-press-hook* #'handle-key-press
- *configure-request-hook* #'handle-configure-request
- *configure-notify-hook* #'handle-configure-notify
- *destroy-notify-hook* #'handle-destroy-notify
- *enter-notify-hook* #'handle-enter-notify
- *exposure-hook* #'handle-exposure
- *map-request-hook* #'handle-map-request
- *unmap-notify-hook* #'handle-unmap-notify
- *create-notify-hook* #'handle-create-notify
- *button-press-hook* #'handle-button-press
- *button-release-hook* #'handle-button-release
- *motion-notify-hook* #'handle-motion-notify)
+(setf *key-press-hook* 'handle-key-press
+ *configure-request-hook* 'handle-configure-request
+ *configure-notify-hook* 'handle-configure-notify
+ *destroy-notify-hook* 'handle-destroy-notify
+ *enter-notify-hook* 'handle-enter-notify
+ *exposure-hook* 'handle-exposure
+ *map-request-hook* 'handle-map-request
+ *unmap-notify-hook* 'handle-unmap-notify
+ *create-notify-hook* 'handle-create-notify
+ *button-press-hook* 'handle-button-press
+ *button-release-hook* 'handle-button-release
+ *motion-notify-hook* 'handle-motion-notify)
@@ -192,6 +192,14 @@
(getenv "DISPLAY") display-str)))
+
+(defun default-init-hook ()
+ (let ((frame (add-frame (create-frame :name "Default"
+ :layout nil :x 0.05 :y 0.05
+ :w 0.9 :h 0.9) *root-frame*)))
+ (setf *current-child* frame)))
+
+
(defun init-display ()
(setf *screen* (first (xlib:display-roots *display*))
*root* (xlib:screen-root *screen*)
@@ -203,6 +211,9 @@
:drawable *root*))
(xgrab-init-pointer)
(xgrab-init-keyboard)
+ (init-last-child)
+ (init-virtual-keyboard)
+ (init-clfswm-terminal)
(xlib:map-window *no-focus-window*)
(dbg *display*)
(setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Sat Aug 23 17:16:39 2008
@@ -32,12 +32,21 @@
;;; CONFIG - Compress motion notify ?
-(defparameter *have-to-compress-notify* t
- "This variable may be useful to speed up some slow version of CLX.
-It is particulary useful with CLISP/MIT-CLX.")
+;; This variable may be useful to speed up some slow version of CLX.
+;; It is particulary useful with CLISP/MIT-CLX.
+(setf *have-to-compress-notify* t)
+;;; CONFIG - Never managed window list
+(defparameter *never-managed-window-list*
+ '((xlib:get-wm-class "ROX-Pinboard")
+ (xlib:get-wm-class "xvkbd")
+ (xlib:wm-name "clfswm-terminal"))
+ "Config(): CLFSWM will never manage windows of this type.
+A list of (predicate-function-on-window expected-string)")
+
+
;;; CONFIG - Screen size
(defun get-fullscreen-size ()
"Return the size of root child (values rx ry rw rh)
@@ -49,7 +58,71 @@
(defparameter *corner-size* 3
- "The size of the corner square")
+ "Config(Corner group): The size of the corner square")
+
+
+;;; CONFIG: Corner actions - See in clfswm-corner.lisp for
+;;; allowed functions
+(defparameter *corner-main-mode-left-button*
+ '((:top-left nil)
+ (:top-right present-virtual-keyboard)
+ (:bottom-right present-windows)
+ (:bottom-left nil))
+ "Config(Corner group): Actions on corners in the main mode with the left mouse button")
+
+(defparameter *corner-main-mode-middle-button*
+ '((:top-left help-on-clfswm)
+ (:top-right ask-close/kill-current-window)
+ (:bottom-right nil)
+ (:bottom-left nil))
+ "Config(Corner group): Actions on corners in the main mode with the middle mouse button")
+
+(defparameter *corner-main-mode-right-button*
+ '((:top-left present-clfswm-terminal)
+ (:top-right ask-close/kill-current-window)
+ (:bottom-right present-all-windows)
+ (:bottom-left nil))
+ "Config(Corner group): Actions on corners in the main mode with the right mouse button")
+
+(defparameter *corner-second-mode-left-button*
+ '((:top-left nil)
+ (:top-right nil)
+ (:bottom-right present-windows)
+ (:bottom-left nil))
+ "Config(Corner group): Actions on corners in the second mode with the left mouse button")
+
+(defparameter *corner-second-mode-middle-button*
+ '((:top-left help-on-clfswm)
+ (:top-right nil)
+ (:bottom-right nil)
+ (:bottom-left nil))
+ "Config(Corner group): Actions on corners in the second mode with the middle mouse button")
+
+(defparameter *corner-second-mode-right-button*
+ '((:top-left nil)
+ (:top-right nil)
+ (:bottom-right present-all-windows)
+ (:bottom-left nil))
+ "Config(Corner group): Actions on corners in the second mode with the right mouse button")
+
+
+(defparameter *virtual-keyboard-cmd* "xvkbd"
+ "Config(Corner group): The command to display the virtual keybaord
+ Here is an ~/.Xresources example for xvkbd:
+ xvkbd.windowGeometry: 300x100-0-0
+ xvkbd*Font: 6x12
+ xvkbd.modalKeytop: true
+ xvkbd.customization: -french
+ xvkbd.keypad: false
+ And make it always on top")
+(defparameter *virtual-keyboard-kill-cmd* "pkill xvkbd"
+ "Config(Corner group): The command to stop the virtual keyboard")
+
+(defparameter *clfswm-terminal-name* "clfswm-terminal"
+ "Config(Corner group): The clfswm terminal name")
+(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A" *clfswm-terminal-name*)
+ "Config(Corner group): The clfswm terminal command.
+This command must set the window title to *clfswm-terminal-name*")
@@ -64,97 +137,109 @@
;;;
;;; See clfswm.lisp for hooks examples.
-(defun default-init-hook ()
- (let ((frame (add-frame (create-frame :name "Default"
- :layout nil :x 0.05 :y 0.05
- :w 0.9 :h 0.9) *root-frame*)))
- (setf *current-child* frame)))
-
(defparameter *init-hook* 'default-init-hook
- "Init hook. This hook is run just after the first root frame is created")
+ "Config(Hook group): Init hook. This hook is run just after the first root frame is created")
(defparameter *default-nw-hook* 'default-frame-nw-hook
- "Default action to do on newly created windows")
+ "Config(Hook group): Default action to do on newly created windows")
;;; CONFIG
(defparameter *create-frame-on-root* nil
- "Set this variable to true if you want to allow to create a new frame
+ "Config(): Create frame on root.
+Set this variable to true if you want to allow to create a new frame
on the root window in the main mode with the mouse")
-;;; CONFIG: Corner where to present windows (An expose like)
-(defparameter *present-windows-corner* :bottom-right
- "Which corner enable the mouse present windows.
-One of :bottom-right :bottom-left :top-right :top-left")
-
-(defparameter *present-all-windows-corner* :bottom-left
- "Which corner enable the mouse present all windows
-One of :bottom-right :bottom-left :top-right :top-left")
-
-(defparameter *present-virtual-keyboard-corner* :top-right
- "Which corner enable the mouse present virtual keyboard.
-One of :bottom-right :bottom-left :top-right :top-left")
-
-(defparameter *virtual-keyboard-cmd* "xvkbd"
- "The command to display the virtual keybaord
- Here is an ~/.Xresources example for xvkbd:
- xvkbd.windowGeometry: 300x100-0-0
- xvkbd*Font: 6x12
- xvkbd.modalKeytop: true
- xvkbd.customization: -french
- xvkbd.keypad: false
- And make it always on top")
-(defparameter *virtual-keyboard-kill-cmd* "pkill xvkbd")
-
-
-
;;; CONFIG: Main mode colors
-(defparameter *color-selected* "Red")
-(defparameter *color-unselected* "Blue")
-(defparameter *color-maybe-selected* "Yellow")
+(defparameter *color-selected* "Red"
+ "Config(Main mode group): Color of selected window")
+(defparameter *color-unselected* "Blue"
+ "Config(Main mode group): Color of unselected color")
+(defparameter *color-maybe-selected* "Yellow"
+ "Config(Main mode group): Color of maybe selected windows")
;;; CONFIG: Default window size
-(defparameter *default-window-width* 400)
-(defparameter *default-window-height* 300)
+(defparameter *default-window-width* 400
+ "Config(): Default window width")
+(defparameter *default-window-height* 300
+ "Config(): Default window height")
;;; CONFIG: Second mode colors and fonts
-(defparameter *sm-border-color* "Green")
-(defparameter *sm-background-color* "Black")
-(defparameter *sm-foreground-color* "Red")
-(defparameter *sm-font-string* "9x15bold")
-(defparameter *sm-width* 300)
-(defparameter *sm-height* 25)
+(defparameter *sm-border-color* "Green"
+ "Config(Second mode group): Second mode window border color")
+(defparameter *sm-background-color* "Black"
+ "Config(Second mode group): Second mode window background color")
+(defparameter *sm-foreground-color* "Red"
+ "Config(Second mode group): Second mode window foreground color")
+(defparameter *sm-font-string* "9x15bold"
+ "Config(Second mode group): Second mode window font string")
+(defparameter *sm-width* 300
+ "Config(Second mode group): Second mode window width")
+(defparameter *sm-height* 25
+ "Config(Second mode group): Second mode window height")
;;; CONFIG - Identify key colors
-(defparameter *identify-font-string* "9x15")
-(defparameter *identify-background* "black")
-(defparameter *identify-foreground* "green")
-(defparameter *identify-border* "red")
+(defparameter *identify-font-string* "9x15"
+ "Config(Identify key group): Identify window font string")
+(defparameter *identify-background* "black"
+ "Config(Identify key group): Identify window background color")
+(defparameter *identify-foreground* "green"
+ "Config(Identify key group): Identify window foreground color")
+(defparameter *identify-border* "red"
+ "Config(Identify key group): Identify window border color")
;;; CONFIG - Query string colors
-(defparameter *query-font-string* "9x15")
-(defparameter *query-background* "black")
-(defparameter *query-foreground* "green")
-(defparameter *query-border* "red")
+(defparameter *query-font-string* "9x15"
+ "Config(Query string group): Query string window font string")
+(defparameter *query-background* "black"
+ "Config(Query string group): Query string window background color")
+(defparameter *query-foreground* "green"
+ "Config(Query string group): Query string window foreground color")
+(defparameter *query-border* "red"
+ "Config(Query string group): Query string window border color")
;;; CONFIG - Info mode
+(defparameter *info-background* "black"
+ "Config(Info mode group): Info window background color")
+(defparameter *info-foreground* "green"
+ "Config(Info mode group): Info window foreground color")
+(defparameter *info-border* "red"
+ "Config(Info mode group): Info window border color")
+(defparameter *info-line-cursor* "white"
+ "Config(Info mode group): Info window line cursor color color")
+(defparameter *info-font-string* "9x15"
+ "Config(Info mode group): Info window font string")
+
+;;; CONFIG - Show key binding colors
+(defparameter *info-color-title* "Magenta"
+ "Config(Info mode group): Colored info title color")
+(defparameter *info-color-underline* "Yellow"
+ "Config(Info mode group): Colored info underline color")
+(defparameter *info-color-first* "Cyan"
+ "Config(Info mode group): Colored info first color")
+(defparameter *info-color-second* "lightblue"
+ "Config(Info mode group): Colored info second color")
+
+
+;;; CONFIG - Menu colors
+;;; Set *info-foreground* to change the default menu foreground
+(defparameter *menu-color-submenu* "Cyan"
+ "Config(Menu group): Submenu color in menu")
+(defparameter *menu-color-comment* "Yellow"
+ "Config(Menu group): Comment color in menu")
+(defparameter *menu-color-key* "Magenta"
+ "Config(Menu group): Key color in menu")
+(defparameter *menu-color-menu-key* (->color #xFF9AFF)
+ "Config(Menu group): Menu key color in menu")
-(defparameter *info-background* "black")
-(defparameter *info-foreground* "green")
-(defparameter *info-border* "red")
-(defparameter *info-line-cursor* "white")
-(defparameter *info-font-string* "9x15")
-;;; Tiling to side parameters
-(defparameter *tile-workspace-function* 'tile-workspace-top)
-(defparameter *tile-border-size* 200)
Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp (original)
+++ clfswm/src/menu-def.lisp Sat Aug 23 17:16:39 2008
@@ -47,19 +47,6 @@
-;;(defun frame-layout-menu ()
-;; "< Frame layout menu >"
-;; (info-mode-menu (keys-from-list *layout-list*)))
-;;
-;;(defun frame-layout-once-menu ()
-;; "< Frame layout menu (Set only once) >"
-;; (info-mode-menu (keys-from-list (loop :for l :in *layout-list*
-;; :collect (create-symbol (format nil "~A" l) "-ONCE")))))
-;;
-;;(defun frame-nw-hook-menu ()
-;; "< Frame new window hook menu >"
-;; (info-mode-menu (keys-from-list *nw-hook-list*)))
-
(add-sub-menu 'main "c" 'child-menu "Child menu")
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Sat Aug 23 17:16:39 2008
@@ -30,9 +30,21 @@
;;(:shadow :defun)
(:export :main))
+
+
(in-package :clfswm)
+
+;;; Compress motion notify ?
+;;; Note: this variable is overwriten in config.lisp
+(defparameter *have-to-compress-notify* t
+ "Config(): Compress event notify?
+This variable may be useful to speed up some slow version of CLX.
+It is particulary useful with CLISP/MIT-CLX.")
+
+
+
(defparameter *display* nil)
(defparameter *screen* nil)
(defparameter *root* nil)
@@ -44,32 +56,30 @@
(defparameter *default-font* nil)
;;(defparameter *default-font-string* "9x15")
-(defparameter *default-font-string* "fixed")
+(defparameter *default-font-string* "fixed"
+ "Config(): The default font used in clfswm")
(defparameter *child-selection* nil)
-(defparameter *layout-list* nil)
-(defparameter *nw-hook-list* nil)
-
-
-;;(defstruct frame (number (incf *current-frame-number*)) name
-;; (x 0) (y 0) (w 1) (h 1) rx ry rw rh
-;; layout window gc child)
-
;;; CONFIG - Default frame datas
(defparameter *default-frame-data*
- (list '(:tile-size 0.8) '(:tile-space-size 0.1)))
+ (list '(:tile-size 0.8) '(:tile-space-size 0.1)
+ '(:fast-layout (tile-left-layout tile-layout)))
+ "Config(): Default slots set in frame date")
;;; CONFIG - Default managed window type for a frame
;;; type can be :all, :normal, :transient, :maxsize, :desktop, :dock, :toolbar, :menu, :utility, :splash, :dialog
-(defparameter *default-managed-type* '(:normal))
+(defparameter *default-managed-type* '(:normal)
+ "Config(): Default managed window types")
;;(defparameter *default-managed-type* '(:normal :maxsize :transient))
;;(defparameter *default-managed-type* '(:normal :transient :maxsize :desktop :dock :toolbar :menu :utility :splash :dialog))
;;(defparameter *default-managed-type* '())
;;(defparameter *default-managed-type* '(:all))
+
+
(defclass frame ()
((name :initarg :name :accessor frame-name :initform nil)
(number :initarg :number :accessor frame-number :initform 0)
@@ -140,37 +150,65 @@
;;; Main mode hooks (set in clfswm.lisp)
-(defparameter *button-press-hook* nil)
-(defparameter *button-release-hook* nil)
-(defparameter *motion-notify-hook* nil)
-(defparameter *key-press-hook* nil)
-(defparameter *configure-request-hook* nil)
-(defparameter *configure-notify-hook* nil)
-(defparameter *create-notify-hook* nil)
-(defparameter *destroy-notify-hook* nil)
-(defparameter *enter-notify-hook* nil)
-(defparameter *exposure-hook* nil)
-(defparameter *map-request-hook* nil)
-(defparameter *mapping-notify-hook* nil)
-(defparameter *property-notify-hook* nil)
-(defparameter *unmap-notify-hook* nil)
+(defparameter *button-press-hook* nil
+ "Config(Hook group):")
+(defparameter *button-release-hook* nil
+ "Config(Hook group):")
+(defparameter *motion-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *key-press-hook* nil
+ "Config(Hook group):")
+(defparameter *configure-request-hook* nil
+ "Config(Hook group):")
+(defparameter *configure-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *create-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *destroy-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *enter-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *exposure-hook* nil
+ "Config(Hook group):")
+(defparameter *map-request-hook* nil
+ "Config(Hook group):")
+(defparameter *mapping-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *property-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *unmap-notify-hook* nil
+ "Config(Hook group):")
;;; Second mode hooks (set in clfswm-second-mode.lisp)
-(defparameter *sm-button-press-hook* nil)
-(defparameter *sm-button-release-hook* nil)
-(defparameter *sm-motion-notify-hook* nil)
-(defparameter *sm-key-press-hook* nil)
-(defparameter *sm-configure-request-hook* nil)
-(defparameter *sm-configure-notify-hook* nil)
-(defparameter *sm-map-request-hook* nil)
-(defparameter *sm-unmap-notify-hook* nil)
-(defparameter *sm-destroy-notify-hook* nil)
-(defparameter *sm-mapping-notify-hook* nil)
-(defparameter *sm-property-notify-hook* nil)
-(defparameter *sm-create-notify-hook* nil)
-(defparameter *sm-enter-notify-hook* nil)
-(defparameter *sm-exposure-hook* nil)
+(defparameter *sm-button-press-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-button-release-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-motion-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-key-press-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-configure-request-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-configure-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-map-request-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-unmap-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-destroy-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-mapping-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-property-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-create-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-enter-notify-hook* nil
+ "Config(Hook group):")
+(defparameter *sm-exposure-hook* nil
+ "Config(Hook group):")
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Sat Aug 23 17:16:39 2008
@@ -34,15 +34,22 @@
:call-hook
:dbg
:dbgnl
+ :with-all-internal-symbols
+ :export-all-functions :export-all-variables
+ :export-all-functions-and-variables
+ :empty-string-p
+ :is-config-p :config-documentation :config-group
:setf/=
- :in-corner
:create-symbol
+ :number->char
:nth-insert
:split-string
+ :append-newline-space
:expand-newline
:ensure-list
:ensure-printable
:ensure-n-elems
+ :begin-with-2-spaces
:string-equal-p
:find-assoc-word
:print-space
@@ -162,9 +169,78 @@
-;;; Tools
+;;; Symbols tools
+(defmacro with-all-internal-symbols ((var package) &body body)
+ "Bind symbol to all internal symbols in package"
+ `(do-symbols (,var ,package)
+ (multiple-value-bind (sym status)
+ (find-symbol (symbol-name ,var) ,package)
+ (declare (ignore sym))
+ (when (eql status :internal)
+ , at body))))
+
+
+(defun export-all-functions (package &optional (verbose nil))
+ (with-all-internal-symbols (symbol package)
+ (when (fboundp symbol)
+ (when verbose
+ (format t "Exporting ~S~%" symbol))
+ (export symbol package))))
+
+
+(defun export-all-variables (package &optional (verbose nil))
+ (with-all-internal-symbols (symbol package)
+ (when (boundp symbol)
+ (when verbose
+ (format t "Exporting ~S~%" symbol))
+ (export symbol package))))
+
+(defun export-all-functions-and-variables (package &optional (verbose nil))
+ (with-all-internal-symbols (symbol package)
+ (when (or (fboundp symbol) (boundp symbol))
+ (when verbose
+ (format t "Exporting ~S~%" symbol))
+ (export symbol package))))
+
+
+
+
+(defun empty-string-p (string)
+ (string= string ""))
+
+
+
+;;; Auto configuration tools
+;;; Syntaxe: (defparameter symbol value "Config(config group): documentation string")
+(let* ((start-string "Config(")
+ (start-len (length start-string))
+ (stop-string "):")
+ (stop-len (length stop-string)))
+ (defun is-config-p (symbol)
+ (when (boundp symbol)
+ (let ((doc (documentation symbol 'variable)))
+ (and doc
+ (= (or (search start-string doc :test #'string-equal) -1) 0)
+ (search stop-string doc)
+ t))))
+
+ (defun config-documentation (symbol)
+ (when (is-config-p symbol)
+ (let ((doc (documentation symbol 'variable)))
+ (string-trim " " (subseq doc (+ (search stop-string doc) stop-len))))))
+
+ (defun config-group (symbol)
+ (when (is-config-p symbol)
+ (let* ((doc (documentation symbol 'variable))
+ (group (string-trim " " (subseq doc (+ (search start-string doc) start-len)
+ (search stop-string doc)))))
+ (if (empty-string-p group) "Miscellaneous group" group)))))
+
+
+
+;;; Tools
(defmacro setf/= (var val)
"Set var to val only when var not equal to val"
(let ((gval (gensym)))
@@ -179,6 +255,9 @@
"Return a new symbol from names"
(intern (string-upcase (apply #'concatenate 'string names))))
+(defun number->char (number)
+ (code-char (+ (char-code #\a) number)))
+
(defun nth-insert (n elem list)
@@ -198,6 +277,15 @@
while j))
+(defun append-newline-space (string)
+ "Append spaces before Newline on each line"
+ (with-output-to-string (stream)
+ (loop for c across string do
+ (when (equal c #\Newline)
+ (princ " " stream))
+ (princ c stream))))
+
+
(defun expand-newline (list)
"Expand all newline in strings in list"
(let ((acc nil))
@@ -224,6 +312,11 @@
((< length n) (ensure-n-elems (append list '(nil)) n))
((> length n) (ensure-n-elems (butlast list) n)))))
+(defun begin-with-2-spaces (string)
+ (and (> (length string) 1)
+ (eql (char string 0) #\Space)
+ (eql (char string 1) #\Space)))
+
(defun string-equal-p (x y)
(when (stringp y) (string-equal x y)))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Sat Aug 23 17:16:39 2008
@@ -25,7 +25,6 @@
(in-package :clfswm)
-
;; Window states
(defconstant +withdrawn-state+ 0)
(defconstant +normal-state+ 1)
@@ -95,33 +94,6 @@
-(defun in-corner (corner x y)
- "Return t if (x, y) is in corner.
-Corner is one of :bottom-right :bottom-left :top-right :top-left"
- (multiple-value-bind (xmin ymin xmax ymax)
- (case corner
- (:bottom-right (values (- (xlib:screen-width *screen*) *corner-size*)
- (- (xlib:screen-height *screen*) *corner-size*)
- (xlib:screen-width *screen*)
- (xlib:screen-height *screen*)))
- (:bottom-left (values 0
- (- (xlib:screen-height *screen*) *corner-size*)
- *corner-size*
- (xlib:screen-height *screen*)))
- (:top-left (values 0 0 *corner-size* *corner-size*))
- (:top-right (values (- (xlib:screen-width *screen*) *corner-size*)
- 0
- (xlib:screen-width *screen*)
- *corner-size*))
- (t (values 10 10 0 0)))
- (and (<= xmin x xmax)
- (<= ymin y ymax))))
-
-
-
-
-
-
(defun window-state (win)
"Get the state (iconic, normal, withdraw of a window."
(first (xlib:get-property win :WM_STATE)))
@@ -358,13 +330,6 @@
(let ((cursor-font nil)
(cursor nil)
(pointer-grabbed nil))
-;; (labels ((free-grab-pointer ()
-;; (when cursor
-;; (xlib:free-cursor cursor)
-;; (setf cursor nil))
-;; (when cursor-font
-;; (xlib:close-font cursor-font)
- ;; (setf cursor-font nil))))
(defun free-grab-pointer ()
(when cursor
(xlib:free-cursor cursor)
@@ -593,12 +558,32 @@
+(defun get-color (color)
+ (xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
+(defgeneric ->color (color))
+(defmethod ->color ((color-name string))
+ color-name)
-(defun get-color (color)
- (xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
+(defmethod ->color ((color integer))
+ (labels ((hex->float (color)
+ (/ (logand color #xFF) 256.0)))
+ (xlib:make-color :blue (hex->float color)
+ :green (hex->float (ash color -8))
+ :red (hex->float (ash color -16)))))
+
+(defmethod ->color ((color list))
+ (destructuring-bind (red green blue) color
+ (xlib:make-color :blue red :green green :red blue)))
+
+(defmethod ->color ((color xlib:color))
+ color)
+
+(defmethod ->color (color)
+ (format t "Wrong color type: ~A~%" color)
+ "White")
@@ -725,4 +710,3 @@
(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