[clfswm-cvs] r355 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Wed Oct 13 20:36:05 UTC 2010
Author: pbrochard
Date: Wed Oct 13 16:36:04 2010
New Revision: 355
Log:
src/clfswm-info.lisp (show-first-aid-kit): Display the essential key binding in main and second mode.
Modified:
clfswm/ChangeLog
clfswm/src/bindings.lisp
clfswm/src/clfswm-autodoc.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-second-mode.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/menu-def.lisp
clfswm/src/tools.lisp
clfswm/src/version.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Wed Oct 13 16:36:04 2010
@@ -1,3 +1,8 @@
+2010-10-13 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-info.lisp (show-first-aid-kit): Display the essential
+ key binding in main and second mode.
+
2010-10-10 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-util.lisp (open-notify-window): Convert hello-window
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Wed Oct 13 16:36:04 2010
@@ -65,6 +65,7 @@
(define-main-key ("F10" :shift :control) 'toggle-show-root-frame)
(define-main-key ("F10") 'expose-windows-mode)
(define-main-key ("F10" :control) 'expose-all-windows-mode)
+ (define-main-key ("L2" :control) 'present-clfswm-terminal)
(define-main-key (#\b :mod-1) 'banish-pointer)
;; Escape
(define-main-key ("Escape" :control) 'ask-close/kill-current-window)
Modified: clfswm/src/clfswm-autodoc.lisp
==============================================================================
--- clfswm/src/clfswm-autodoc.lisp (original)
+++ clfswm/src/clfswm-autodoc.lisp Wed Oct 13 16:36:04 2010
@@ -91,7 +91,7 @@
-(defun produce-doc (hash-table-key-list &optional (stream t))
+(defun produce-doc (hash-table-key-list &optional (stream t) (display-producing-doc t))
"Produce a text doc from a hash-table key"
(format stream " * CLFSWM Keys *~%")
(format stream " -----------~%")
@@ -109,7 +109,8 @@
(documentation (or (first v) (third v)) 'function))))
hk)
(format stream "~2&"))
- (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions.
+ (when display-producing-doc
+ (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.
@@ -117,7 +118,7 @@
LISP> (in-package :clfswm)
CLFSWM> (produce-doc-in-file \"my-keys.txt\")
or
-CLFSWM> (produce-all-docs)~2%"))
+CLFSWM> (produce-all-docs)~2%")))
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Wed Oct 13 16:36:04 2010
@@ -436,12 +436,14 @@
(defun show-key-binding (&rest hash-table-key)
- "Show the binding of each hash-table-key"
+ "Show the binding of each hash-table-key.
+Pass the :no-producing-doc symbol to remove the producing doc"
(info-mode (key-binding-colorize-line
(split-string (append-newline-space
(with-output-to-string (stream)
- (produce-doc hash-table-key
- stream)))
+ (produce-doc (remove :no-producing-doc hash-table-key)
+ stream
+ (not (member :no-producing-doc hash-table-key)))))
#\Newline))))
@@ -467,6 +469,37 @@
(show-key-binding *expose-keys* *expose-mouse*))
+(defun show-first-aid-kit ()
+ "Show the first aid kit key binding"
+ (labels ((add-key (hash symbol &optional (hashkey *main-keys*))
+ (multiple-value-bind (k v)
+ (find-in-hash symbol hashkey)
+ (setf (gethash k hash) v))))
+ (let ((hash (make-hash-table :test #'equal))
+ (hash-second (make-hash-table :test #'equal)))
+ (setf (gethash 'name hash) "First aid kit - Main mode key binding"
+ (gethash 'name hash-second) "First aid kit - Second mode key binding")
+ (add-key hash 'select-next-child)
+ (add-key hash 'select-previous-child)
+ (add-key hash 'select-next-brother)
+ (add-key hash 'select-previous-brother)
+ (add-key hash 'select-previous-level)
+ (add-key hash 'select-next-level)
+ (add-key hash 'enter-frame)
+ (add-key hash 'leave-frame)
+ (add-key hash 'second-key-mode)
+ (add-key hash 'expose-windows-mode)
+ (add-key hash 'expose-all-windows-mode)
+ (add-key hash 'present-clfswm-terminal)
+ (add-key hash-second 'leave-second-mode *second-keys*)
+ (add-key hash-second 'open-menu *second-keys*)
+ (add-key hash-second 'run-program-from-query-string *second-keys*)
+ (add-key hash-second 'eval-from-query-string *second-keys*)
+ (add-key hash-second 'set-open-in-new-frame-in-parent-frame-nw-hook *second-keys*)
+ (add-key hash-second 'b-start-xterm *second-keys*)
+ (add-key hash-second 'b-start-emacs *second-keys*)
+ (show-key-binding hash hash-second :no-producing-doc))))
+
(defun corner-help-colorize-line (list)
(loop :for line :in list
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Wed Oct 13 16:36:04 2010
@@ -141,7 +141,7 @@
(setf *in-second-mode* nil))
(defun second-key-mode ()
- "Switch to editing mode"
+ "Switch to editing mode (second mode)"
(generic-mode 'second-mode
'exit-second-loop
:enter-function #'sm-enter-function
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Wed Oct 13 16:36:04 2010
@@ -330,7 +330,7 @@
(defun eval-from-query-string ()
"Eval a lisp form from the query input"
- (let ((form (query-string "Eval:"))
+ (let ((form (query-string (format nil "Eval Lisp - ~A" (package-name *package*))))
(result nil))
(when (and form (not (equal form "")))
(let ((printed-result
Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp (original)
+++ clfswm/src/menu-def.lisp Wed Oct 13 16:36:04 2010
@@ -64,6 +64,7 @@
(create-configuration-menu)
+(add-menu-key 'help-menu "a" 'show-first-aid-kit)
(add-menu-key 'help-menu "h" 'show-global-key-binding)
(add-menu-key 'help-menu "b" 'show-main-mode-key-binding)
(add-menu-key 'help-menu "s" 'show-second-mode-key-binding)
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Wed Oct 13 16:36:04 2010
@@ -31,6 +31,7 @@
(:export :it
:awhen
:aif
+ :find-in-hash
:nfuncall
:pfuncall
:symbol-search
@@ -40,6 +41,7 @@
:remove-hook
:clear-timers
:add-timer
+ :at
:with-timer
:process-timers
:erase-timer
@@ -121,6 +123,15 @@
(defmacro aif (test then &optional else)
`(let ((it ,test)) (if it ,then ,else)))
+
+(defun find-in-hash (val hashtable &optional (test #'equal))
+ "Return the key associated to val in the hashtable"
+ (maphash #'(lambda (k v)
+ (when (and (consp v) (funcall test (first v) val))
+ (return-from find-in-hash (values k v))))
+ hashtable))
+
+
(defun nfuncall (function)
(when function
(funcall function)))
@@ -193,6 +204,7 @@
(setf *timer-list* nil))
(defun add-timer (delay fun &optional (id (gensym)))
+ "Start the function fun at delay seconds."
(push (list id
(let ((time (+ (get-internal-real-time) (s->realtime delay))))
(lambda ()
@@ -202,7 +214,12 @@
*timer-list*)
id)
+(defun at (delay fun &optional (id (gensym)))
+ "Start the function fun at delay seconds."
+ (funcall #'add-timer delay fun id))
+
(defmacro with-timer ((delay &optional (id (gensym))) &body body)
+ "Same thing as add-timer but with syntaxic sugar"
`(add-timer ,delay
(lambda ()
, at body)
@@ -210,11 +227,13 @@
(defun process-timers ()
+ "Call each timers in *timer-list* if needed"
(dolist (timer *timer-list*)
(when (funcall (second timer))
(setf *timer-list* (remove timer *timer-list* :test #'equal)))))
(defun erase-timer (id)
+ "Erase the timer identified by its id"
(dolist (timer *timer-list*)
(when (equal id (first timer))
(setf *timer-list* (remove timer *timer-list* :test #'equal)))))
Modified: clfswm/src/version.lisp
==============================================================================
--- clfswm/src/version.lisp (original)
+++ clfswm/src/version.lisp Wed Oct 13 16:36:04 2010
@@ -33,4 +33,4 @@
(in-package :version)
-(defparameter *version* #.(concatenate 'string "Version: 1.0 built " (date-string)))
+(defparameter *version* #.(concatenate 'string "Version: 10.10 built " (date-string)))
More information about the clfswm-cvs
mailing list