1
;; prompt-wm.jl -- prompt variants for windows/workspaces
2
;; $Id: prompt-wm.jl,v 1.6 2000/09/11 07:44:42 john Exp $
4
;; Contributed by Dave Pearson <davep@davep.org>
6
;; This file is part of sawmill.
8
;; sawmill is free software; you can redistribute it and/or modify it
9
;; under the terms of the GNU General Public License as published by
10
;; the Free Software Foundation; either version 2, or (at your option)
13
;; sawmill is distributed in the hope that it will be useful, but
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with sawmill; see the file COPYING. If not, write to
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
(declare (in-module sawfish.wm.util.prompt))
24
(require 'sawfish.wm.workspace)
25
(require 'sawfish.wm.windows)
27
(define (prompt-for-window #!optional title)
28
"Prompt for a window title, return the window associated with that title."
29
(letrec ((show-in-list-p
32
(not (window-get w 'ignored))
33
(window-get w 'workspaces))))
37
(if (show-in-list-p (car windows))
38
(cons (window-name (car windows))
39
(window-names (cdr windows)))
40
(window-names (cdr windows))))))
44
(if (string-match re (car names))
45
(cons (car names) (names-matching re (cdr names)))
46
(names-matching re (cdr names))))))
47
(prompt-completion-fun
49
(names-matching (format nil "^%s" text)
50
(sort (window-names (managed-windows)))))))
51
(let ((window-title (prompt (or title (_ "Window:")))))
52
(unless (zerop (length window-title))
53
(cdr (assoc window-title (mapcar (lambda (w)
54
(cons (window-name w) w))
55
(managed-windows))))))))
57
(define (prompt-for-workspace #!optional title)
58
"Prompt for a workspace title, return the workspace number."
59
(letrec ((make-workspace-list
62
(cons (or (nth (1- ws) workspace-names)
63
(format nil (_ "Workspace %d") ws))
64
(make-workspace-list (1- ws))))))
67
(reverse (make-workspace-list (1+ (cdr (workspace-limits)))))))
71
(if (string-match re (car names))
72
(cons (car names) (names-matching re (cdr names)))
73
(names-matching re (cdr names))))))
74
(prompt-completion-fun
76
(names-matching (format nil "^%s" text) (workspaces)))))
77
(let ((ws-title (prompt (or title (_ "Workspace:"))))
79
(unless (zerop (length ws-title))
80
(let ((where (member ws-title wsl)))
82
(- (length wsl) (length where))))))))
added
removed
lisp/sawfish/wm/util/prompt-wm.jl
