[STUMP] A patch

[Manuel Giraud]

Hi,

With the recent repository update, here is a new patch:

---8<----------------------------------------
Index: core.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/core.lisp,v
retrieving revision 1.8
diff -u -r1.8 core.lisp
--- core.lisp   12 Nov 2004 06:35:47 -0000      1.8
+++ core.lisp   15 Nov 2004 16:26:53 -0000
@@ -65,7 +65,7 @@
                      (xlib:window-equal w (second (screen-mapped-windows 
screen))))
                 #\+)
                (t #\-))
-         (window-name w)))
+         (subseq (window-name w) 0 *window-name-max-length*)))
 
 (defun window-master (window)
   "Find the window's master window (the one it's been reparented to)."
Index: primitives.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/primitives.lisp,v
retrieving revision 1.5
diff -u -r1.5 primitives.lisp
--- primitives.lisp     12 Nov 2004 06:35:47 -0000      1.5
+++ primitives.lisp     15 Nov 2004 16:26:54 -0000
@@ -88,6 +88,10 @@
                   "The function called when printing a window list. It is 
passed the
 screen and window. It should return a string.")
 
+(defvar *window-name-max-length* nil
+  "Truncate the size of the window name in `default-window-format'
+function. NIL means no truncation.")
+
 (defstruct key-binding
   "A structure to map from a keystroke to a command."
   (key nil :type xlib:keysym)
Index: stumpwm.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/stumpwm.lisp,v
retrieving revision 1.21
diff -u -r1.21 stumpwm.lisp
--- stumpwm.lisp        12 Nov 2004 06:35:47 -0000      1.21
+++ stumpwm.lisp        15 Nov 2004 16:26:54 -0000
@@ -100,6 +100,10 @@
   ;; In the event of an error, we always need to close the display
   (unwind-protect
       (progn
+       ;; Load rc file
+       (multiple-value-bind (success err rc) (load-rc-file)
+         (unless success
+           (format t "Error loading ~A: ~A" rc err)))
        ;; Initialize all the screens
        (handler-case
         (setf *screen-list* (mapcar #'init-screen (xlib:display-roots 
*display*)))
@@ -114,10 +118,6 @@
        ;; Setup our keys. FIXME: should this be in the hook?
        (set-default-bindings)
        (echo-string (first *screen-list*) "Welcome to The Stump Window 
Manager!")
-       (multiple-value-bind (success err rc) (load-rc-file)
-         (unless success
-           (echo-string (first *screen-list*)
-                        (format "Error loading ~A: ~A" rc err))))
        (run-hook *start-hook*)
        ;; Let's manage.
        (stumpwm-internal-loop))
Index: user.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/user.lisp,v
retrieving revision 1.6
diff -u -r1.6 user.lisp
--- user.lisp   12 Nov 2004 06:35:47 -0000      1.6
+++ user.lisp   15 Nov 2004 16:26:54 -0000
@@ -173,6 +173,22 @@
     (unless (null cmd)
       (port:run-prog *shell-program* :args (list "-c" cmd) :wait nil))))
 
+(defun run-command-string (str)
+  "Execute the given command string."
+  (let* ((split (remove "" (split-sequence:split-sequence #\Space str) :test 
'string-equal))
+        (prog (car split))
+        (args (cdr split)))
+    (port:run-prog prog :args args :wait nil)))
+
+(defun partial-command (prompt cmd)
+  "Provide a function that will execute the command completed by the
+stumpwm user. Behave mostly like `shell-command' if PROMPT is the
+empty string."
+  #'(lambda (screen)
+      (let ((cmd (read-one-line screen prompt cmd)))
+       (unless (null cmd)
+         (run-command-string cmd)))))
+
 (defun horiz-split-frame (screen)
   (split-frame screen (lambda (f) (split-frame-h screen f))))
 
---8<----------------------------------------

I also propose to integrate a rc-file example, like this one:
---8<----------------------------------------
;; -*-lisp-*-
(in-package :stumpwm)

;; Basic
(set-key-binding #\c '() (lambda (s) (run-command-string "xterm")))
(set-key-binding #\e '() (lambda (s) (run-command-string "emacs")))
;; Read some doc
(set-key-binding #\d '() (lambda (s) (run-command-string "gv")))
;; Browse somewhere
(set-key-binding #\b '() (partial-command "" "firefox http://www.";))
;; Ssh somewhere
(set-key-binding #\s '(:control) (partial-command "" "xterm -e ssh "))
;; Lock screen
(set-key-binding #\l '(:control) (lambda (s) (run-command-string "xlock")))

;; Web search (works for Google and Imdb)
(defun make-web-search (prompt prefix)
  #'(lambda (s)
      (let ((search (read-one-line s prompt)))
        (unless (null search)
          (run-command-string 
           (concatenate 'string prefix
                        (substitute #\+ #\Space search)))))))
(set-key-binding #\g '() (make-web-search "Google search: " "firefox 
http://www.google.fr/search?q=";))
(set-key-binding #\i '() (make-web-search "IMDB search: " "firefox 
http://www.imdb.com/find?q=";))

;; Message window font
(setf *font-name* 
"-xos4-terminus-medium-r-normal--14-140-72-72-c-80-iso8859-15")
---8<----------------------------------------

-- 
Manuel Giraud (CNRS/CETP)