---
tile-window.lisp | 13 +++++++++++++
window.lisp | 16 ++++++++++------
2 files changed, 23 insertions(+), 6 deletions(-)
diff --git a/tile-window.lisp b/tile-window.lisp
index 76aa43f..b95576a 100644
--- a/tile-window.lisp
+++ b/tile-window.lisp
@@ -432,3 +432,16 @@ frame. Possible values are:
(floor (- (frame-height frame) height)
(window-height-inc window)))))
(maximize-window window))))
+
+(defcommand frame-windowlist (&optional (fmt *window-format*)) (:rest)
+ "Allow the user to select a window from the list of windows in the current
+frame and focus the selected window. The optional argument @var{fmt} can be
+specified to override the default window formatting."
+ (let* ((group (current-group))
+ (frame (tile-group-current-frame group)))
+ (if (null (frame-windows group frame))
+ (message "No Managed Windows")
+ (let ((window (select-window-from-menu (frame-sort-windows group frame)
fmt)))
+ (if window
+ (group-focus-window group window)
+ (throw 'error :abort))))))
diff --git a/window.lisp b/window.lisp
index 4535c92..baf9ee6 100644
--- a/window.lisp
+++ b/window.lisp
@@ -826,6 +826,15 @@ needed."
(dformat 3 "Kill client~%")
(xlib:kill-client *display* (xlib:window-id window)))
+(defun select-window-from-menu (windows fmt)
+ "Allow the user to select a window from the list passed in @var{windows}.
The
+...@var{fmt} argument specifies the window formatting used. Returns the window
+selected."
+ (second (select-from-menu (current-screen)
+ (mapcar (lambda (w)
+ (list (format-expand *window-formatters*
fmt w) w))
+ windows))))
+
;;; Window commands
(defcommand delete-window (&optional (window (current-window))) ()
@@ -928,12 +937,7 @@ override the default window formatting."
(if (null (group-windows (current-group)))
(message "No Managed Windows")
(let* ((group (current-group))
- (window (second (select-from-menu
- (current-screen)
- (mapcar (lambda (w)
- (list (format-expand
*window-formatters* fmt w) w))
- (sort-windows group))))))
-
+ (window (select-window-from-menu (sort-windows group) fmt)))
(if window
(group-focus-window group window)
(throw 'error :abort)))))
--
1.6.2.2
_______________________________________________
Stumpwm-devel mailing list
Stumpwm-devel@nongnu.org
http://lists.nongnu.org/mailman/listinfo/stumpwm-devel
