dot-sawfish/lisp/iswitch-window.jl

   1 ;; iswitch-window.jl  (mmc's version) v1.5 -- incremental search for windows
   2
   3
   4
   5 ;; Copyright (C) 2000 Topi Paavola <tjp@iki.fi>
   6 ;; Modifications and enhancements by Jens-Ulrik Petersen
   7 ;; <jens-ulrik.petersen@nokia.com>
   8
   9
  10 ;; Copyright (C) 2003-2005  Michal Maruska   <mmc@maruska.dyndns.org>
  11 ;; http://maruska.dyndns.org/comp/activity/darcs/sawfish/lisp/mmc/iswitch-window.jl
  12
  13 ;; This file is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18
  19 ;;; mmc: NEW FEATURES [14 giu 05]
  20
  21 ;; - current-search   after i make an isearch, the list of matching window is rememebered, and can by x-cycled. (command `cycle-search-start')
  22 ;; - display          integrated w/ x-message: since 13/6/2005  W/O flickering!!  (when you cycle the window list)
  23 ;; - [18 dic 04]   ADT to contain the restrictions,  it's a (a)list
  24 ;;     then i can make some specific calls (with partial restriction)..
  25 ;;     iswitch-window-on-viewport  for example  .. [18 dic 04] in fact i can.
  26 ;;
  27 ;;  call-for-next-key-events*
  28
  29
  30 ;; [11 gen 06]  serializing the query: as a list of nested conditions.
  31
  32
  33
  34
  35
  36 ;;; Commentary:
  37
  38 ;; Incremental window search, similar to iswitchb.el in emacs.
  39 ;;
  40 ;; Default keys (change in iswitch-get-window; ideally we should have an
  41 ;; iswitch-keymap):
  42 ;;
  43 ;; C-s,A-s,TAB    find next matching window
  44 ;; C-r,A-r,M-TAB  find previous matching window
  45 ;; C-g,ESC        quit iswitch
  46 ;; C-u            clear input buffer
  47 ;; backspace      delete previous character
  48 ;; C-z,A-z        iconify window
  49 ;; C-h,A-h        shade window
  50 ;; RET            select window
  51 ;;
  52 ;; Other keys insert themselves. A-s (or H-s, depending on your
  53 ;; modifiers) would be a good key to bind iswitch-window to; for example,
  54 ;;
  55 ;;   (bind-keys global-keymap "A-s" 'iswitch-window)
  56 ;;
  57 ;; The iswitch-window-with function also does something to the current
  58 ;; window. For example,
  59 ;;
  60 ;;   (bind-keys global-keymap "A-s" '(iswitch-window-with
  61 ;;                                    (lambda (w) (iconify-window w))))
  62 ;;
  63 ;; would iconify the currently focused window and focus the newly
  64 ;; selected window.
  65 ;;
  66 ;; This file is available at
  67 ;;   http://aton.co.jyu.fi/~tjp/sawfish/iswitch-window.jl
  68 ;; and can also be found in the sawfish software map:
  69 ;;   http://adraken.themes.org/map.php
  70 ;;
  71 ;; 1.3:
  72 ;; * Updated URL.
  73 ;; * Added iswitch-show-window-class variable.
  74 ;; * Fixed problem with undefined classes, thanks to Matt Tucker.
  75 ;; 1.2:
  76 ;; * Added patches, A-z, A-h, reverse cycling (A-r) and
  77 ;;   iswitch-window-with from Jens.
  78 ;; * TAB and M-TAB now do the same as A-s and A-r.
  79 ;;
  80
  81
  82 (define-structure mmc.iswitch-window
  83     (export
  84       iswitch-window
  85       iswitch-get-window
  86       iswitch-window-line
  87       ;;
  88       replay-criterions)
  89     (open
  90      rep
  91      rep.regexp
  92      rep.system                         ;beep !
  93      ;rep.mmsystem ;; not used here
  94
  95      ;;[17 dic 04]
  96      rep.data.records
  97
  98      rep.trace
  99
 100      rep.io.timers
 101      sawfish.wm.windows
 102      sawfish.wm.misc                    ;grab!
 103      sawfish.wm.events
 104      sawfish.wm.commands
 105      sawfish.wm.custom
 106      sawfish.wm.util.window-order
 107      sawfish.wm.workspace
 108      sawfish.wm.viewport
 109      sawfish.wm.util.display-window
 110      sawfish.wm.state.iconify
 111      sawfish.wm.state.shading
 112
 113      mmc.x-message                      ; i want colored lines!
 114      mmc.my-apps
 115      mmc.adt.list
 116      mmc.simple
 117                                         ;sawfish.wm.commands.x-cycle
 118      mmc.key-continue
 119      )
 120
 121   (define debug #t)
 122
 123   ;; no polymophism!
 124
 125   ;; types:
 126   ;;   substring
 127   ;;    workspace
 128   ;;    state
 129   ;;    viewport
 130   ;;   host
 131   ;;   user
 132   ;;   application   ; win-type  role ?
 133   ;;   ?
 134   ;; `unused'!!!
 135   (define-record-type :iswitch-criterion
 136     (make-criterion) criterion?
 137     (type type-of set-type!)
 138     (model model-of model-y!))
 139
 140 ;; so i could use a 2-list  ( (type model) .....) !
 141   (defvar current-criterion '()
 142     "keep the structured contstraints of the last iswitch.")
 143
 144 ;;; my fix-search  hack  .. todo: replay the current-criterion to avoid killed windows
 145   (defvar current-search nil
 146     "a list of windows, last selected w/ some selecting tool: iswitch-window, wid ..., used by x-cycle")
 147
 148
 149 ;; customize
 150
 151   (defvar iswitch-show-window-class nil
 152     "Display WM_CLASS of windows in the iswitch menu.")
 153
 154   ;;(setq iswitch-show-window-class #t)
 155
 156
 157
 158 ;;; Display
 159
 160 ;; Use the following to customize the look of the menu.
 161
 162   (defvar iswitch-font default-font
 163     "Font for iswitch-window popup")
 164
 165   (defvar iswitch-background-color "white"
 166     "Background color for iswitch-window popup")
 167
 168   (defvar iswitch-foreground-color "black"
 169     "Foreground color for iswitch-window popup")
 170
 171
 172   (define iswitch-visibility-alist
 173     (if #f
 174         '((unobscured . "+")
 175           (partially-obscured . "%")
 176           (fully-obscured . "@"))
 177
 178       '((unobscured . "+")
 179         (partially-obscured . "po")
 180         (fully-obscured . "fo"))
 181       ))
 182
 183   (define iswitch-viewport-direction-alist
 184     '(((1 . 0) . ">")
 185       ((-1 . 0) . "<")
 186       ((0 . 1) . "v")
 187       ((0 . -1) . "^")
 188       ((1 . 1) . ".")
 189       ((-1 . 1) . ",")
 190       ((-1 . -1) . "`")
 191       ((1 . -1) . "'")))
 192
 193 ;; the SGN function  -1 0 1
 194   (define (sign num)
 195     (cond ((> num 0)
 196            1)
 197           ((zerop num)
 198            0)
 199           ((< num 0)
 200            -1)))
 201
 202   (define (iswitch-viewport-direction wv cv)
 203     (let ((wvx (car wv))
 204           (wvy (cdr wv))
 205           (cvx (car cv))
 206           (cvy (cdr cv)))
 207       (cdr (assoc (cons (sign (- wvx cvx)) (sign (- wvy cvy)))
 208                   iswitch-viewport-direction-alist))))
 209
 210
 211
 212   (define (pad-to string needed-len)
 213     (let ((len (length string)))
 214       (cond
 215        ((= len needed-len) string)
 216        ((< len needed-len)
 217         (concat string (make-string (- needed-len len) " ")))
 218        (#t
 219         (substring string 0 needed-len)))))
 220
 221                                         ;(pad-to "michal" 13)
 222                                         ;(make-string 2 " ")
 223
 224 ;; ???
 225   (define (iswitch-window-line w)
 226     (concat
 227      (pad-to
 228       (cond ((window-get w 'iconified)
 229              "i")
 230             ((window-get w 'sticky)
 231              "=")
 232             ((not (window-in-workspace-p w current-workspace))
 233              "X")
 234             ((window-outside-viewport-p w)
 235              (iswitch-viewport-direction (window-viewport w) (screen-viewport)))
 236             ((window-get w 'shaded)
 237              "s")
 238             ((cdr (assoc (window-visibility w)
 239                          iswitch-visibility-alist))))
 240       3)
 241
 242      (if iswitch-show-window-class
 243          (let ((class-name (get-x-text-property w 'WM_CLASS)))
 244            (if class-name
 245                (pad-to                  ;fixme:  make it a minimum but w/o maximum !!!
 246                 (concat "  <"
 247                         (aref class-name 1)
 248                         ">")
 249                 12))))
 250
 251      (window-name w)))
 252
 253
 254   (define (dispatch-condition-format condition)
 255     ;; condition is a list
 256     (let ((type (condition-type condition)))
 257       (symbol-name type)))
 258
 259
 260    (define iswitch-display-window #f  "x-message ")
 261
 262
 263 ;; format user input and window list for display-message
 264   (define (iswitch-display criterions input wlist)
 265     ;(DB "iswitch-display: we have already a window: %s\n" (if iswitch-display-window "yes" "no"))
 266     ;(DB "%s->%s\n" criterions (mapconcat dispatch-condition-format criterions " : "))
 267
 268     ;; [12 giu 05]
 269     ;; (if iswitch-display-window (x-message-hide iswitch-display-window))
 270
 271     (setq iswitch-display-window
 272           (apply
 273            x-message-display
 274            (append ;nconc
 275             (list
 276              '(border-color . "red")
 277              '(border-width . 5)
 278              '(foreground . "yellow")
 279              (mapconcat dispatch-condition-format criterions " : ")
 280              '(foreground . "red")
 281              (concat "  " input)
 282              '(foreground . "green")
 283              (format #f "total: %d" (length wlist))
 284              '(foreground . "gray")
 285              ;(mapconcat dispatch-condition-format criterions " : ")
 286              )
 287             (mapcar iswitch-window-line wlist))
 288
 289            '((background . "black")
 290              (foreground . "gray"))
 291            (if iswitch-display-window
 292                `(#:mwindow ,iswitch-display-window)
 293              '()))))
 294
 295
 296
 297
 298
 299
 300 ;;; Tab cycling:
 301  ;; find next window matching input string
 302   (define (iswitch-rotate-to-next-match input wlist #!optional previous) ; fixme
 303     (setq wlist
 304           (rotate-list-from!
 305            (catch 'iswitch-found
 306              (mapc (lambda (w)
 307                      (when (string-match input (window-name w) 0 t)
 308                        (throw 'iswitch-found w)))
 309                    (if previous
 310                        (reverse (cdr wlist))
 311                      (cdr wlist))))
 312            wlist)))
 313
 314 ;;; filtering:
 315
 316   (define (iswitch-update-match string wlist)
 317     "return the WLIST limited to windows w/ name which matches the INPUT"
 318     ;;(message (format #f "match: 1: %s" (car input)))
 319     (filter (lambda (w)
 320               (let ((name (window-name w)))
 321                 (string-match string name 0 'ignore-case)))
 322             wlist))
 323
 324   (define (iswitch-update-by-name names wlist)
 325     (filter
 326      (lambda (w)
 327        (string-match-string-list-p names (window-name w)))
 328      wlist))
 329
 330                                         ; we need functions !!
 331
 332   (define (iswitch-update-match-class input wlist)
 333     "return the WLIST limited to windows whose class (name) matches the input"
 334     ;;(message (format #f "match: 1: %s" (car input)))
 335     (filter (lambda (w)
 336               (let ((class (window-class w)))
 337                 (string-match-string-list-p input class)))
 338             wlist))
 339
 340   (define (iswitch-update-workspace wlist workspace)
 341     "limit WLIST to those (windows) which are/are NOT on the current ws."
 342     (DB "iswitch-update-workspace: %s\n" workspace)
 343     (let ((condition
 344            (if (consp workspace) ;; (- . 1)
 345                (lambda (w)
 346                  (not (window-in-workspace-p w (cdr workspace))))
 347
 348              (lambda (w)
 349                (window-in-workspace-p w workspace)))))
 350     (filter (lambda (w)
 351               (and
 352                (condition w)
 353                (not (window-iconified-p w))))
 354             wlist)))
 355
 356
 357
 358   (define (iswitch-update-class wlist types)
 359     "the class of window must be one of TYPES (a list of strings)"
 360     (filter (lambda (w)
 361                                         ;(string= type (window-class w)))
 362               (member  (window-class w) types))
 363             wlist))
 364
 365
 366   (define (iswitch-constraint-by wlist predicate)
 367     (filter predicate
 368             wlist))
 369
 370
 371   (define (iswitch-update-viewport wlist info) ;fixme: could it be a boolean value? and i want out of this viewport ??
 372     (declare (unused info))
 373     "limit WLIST to those (windows) which are on the current ws & vieport.   sorry, we need to test ws too."
 374     (let ((workspace current-workspace))
 375       (filter (lambda (w)
 376                 (and
 377                  (not (window-iconified-p w))
 378                  (not (window-outside-viewport-p w))
 379                  (window-in-workspace-p w workspace)))
 380               wlist)))
 381
 382
 383   (define (x-property= window prop-name model)
 384     "is the PROP-NAME X property on WINDOW a string MODEL?"
 385     (let ((prop (get-x-text-property window prop-name)))
 386       (and
 387        prop
 388        (string= (aref prop 0) model))))
 389
 390   (define (windows-on-host wlist hostname)
 391     "use standard & SF specific criterions to find windows `running' on the host HOSTNAME"
 392     (filter ;;-windows
 393      (lambda (window)
 394        (or
 395         (x-property= window 'WM_CLIENT_MACHINE hostname)
 396         (x-property= window 'sf_host hostname)))
 397      wlist))
 398
 399   (define (condition-type condition)
 400     (car condition))
 401
 402    ;;
 403   (define (dispatch-condition wlist condition)
 404     "interpret the (car CONDITION), and dispatch/apply the right function w/ the the (cdr codition)  on WLIST. Return the result."
 405     ;; condition is a list
 406     (let ((type (condition-type condition)))
 407       (case type
 408         ((name)
 409          (iswitch-update-by-name (cdr condition) wlist) ;fixme! order
 410          )
 411         ((class)                        ;classes !!
 412          (iswitch-update-class wlist (cdr condition)))
 413         ((host)
 414          (windows-on-host wlist (cadr condition)))
 415
 416         ((user)
 417          4)
 418         ((application)                  ;
 419          5)
 420
 421         ((workspace)
 422          (iswitch-update-workspace wlist (cadr condition))) ;fixme!
 423
 424         ((viewport)
 425          (iswitch-update-viewport wlist (cadr condition))
 426          )
 427         ((predicate)
 428          ;; fixme: name!
 429          (iswitch-constraint-by wlist (cadr condition)))
 430         )))
 431
 432                                         ;(dispatch-condition (managed-windows) (list 'class "Emacs"))
 433                                         ;(dispatch-condition (managed-windows) (list 'workspace 0))
 434
 435
 436   (define (iswitch-add-condition wlist condition)
 437     (setq current-criterion (cons condition current-criterion))
 438     (dispatch-condition wlist condition))
 439
 440   (define (replay-criterions criterion-list #!optional wlist) ;todo: take an optional wlist argument
 441     "apply the CRITERION-LIST to WLIST (by default `window-order'). See `dispatch-condition' for the list of supported criterions."
 442     (unless wlist
 443       (setq wlist (window-order nil t t))) ;; (managed-windows)
 444     (mapc
 445      (lambda (condition)
 446        (setq wlist (dispatch-condition wlist condition)))
 447      criterion-list)
 448     wlist)
 449
 450
 451
 452   (defmacro iswitch-add-condition! (wlist condition)
 453     "VARIABLE codition"
 454     `(setq ,wlist
 455            (iswitch-add-condition ,wlist ,condition)))
 456
 457
 458 ;;; Main
 459   (define (iswitch-get-windows #!optional criterions)
 460     "Let user pick a window with incremental search and return that window."
 461     (unless criterions
 462       (setq criterions '()))
 463     (call-with-keyboard-grabbed
 464      (lambda ()
 465        (let ((display-timer #f))        ;mmc:  this is when i want to press more keys at once, skipping the initial  all-windows display
 466          ;; fixme: make it a fluid!
 467          (setq current-criterion criterions)
 468          (unwind-protect
 469              (let* ((input "")          ;  current string to be matched
 470                                         ;(constraints ())    ;  other (non textual) constraints  (workspace, viewport, state, ...)
 471                     (init-wlist
 472                      (replay-criterions current-criterion))
 473                     (focused-window (car init-wlist))
 474                     (use-timer #f)
 475
 476                     wlist               ; matching windows ?
 477                     (display-function
 478                      (lambda ()
 479                        (if (< (length wlist) 2)
 480                            ;; bug: this will raise the window too! But C code wil
 481                            ;; then focus & raise (possibly) another window!
 482                            (display-window (car wlist))) ;-without-focusing
 483                        (iswitch-display current-criterion input wlist))))
 484                ;; put the current at the end:
 485                (setq init-wlist (append (cdr init-wlist) (list focused-window))
 486                      wlist init-wlist)
 487
 488 ;;; how we make a recursive event loop:
 489
 490                ;; we tell the C core, that the keymap is void.
 491                ;; then we get all the keys via `unbound-key-hook'
 492                ;; and can invoke ourselves the functions.
 493
 494                ;; we control  allow-events, ungrab-keyboard through  grab-counter
 495                ;; make a copy.
 496                (catch 'exit-iswitch
 497                  (call-for-next-key-events
 498                   (lambda ()
 499                     (if use-timer
 500                         (if display-timer
 501                             (set-timer display-timer)
 502                           (setq  display-timer (make-timer display-function 0 100))) ;we should see other keys first !!
 503                       (display-function)) ;initial list
 504                     (setq use-timer #t)) ; hm??
 505
 506                   (lambda (event-info)
 507                     (let ((key (car event-info))
 508                           (event-string (cdr event-info)))
 509                 ;;; the big `cond':
 510                       (cond ((or (equal key "A-g")
 511                                  (equal key "C-g")
 512                                  (equal key "ESC")) ;fixme: we just lost  the `current-criterion'
 513                              ;; Exit
 514                              (throw 'exit-iswitch nil))
 515
 516                             ((or (equal key "C-u")
 517                                  (equal key "A-u"))
 518                              ;; Reset
 519                              (setq input ""
 520                                    ;;  ???
 521                                    wlist (replay-criterions current-criterion)))
 522                             ;;(iswitch-update-match (cons input constraints) init-wlist)))
 523
 524                             ((or (equal key "BS")
 525                                  (equal key "C-h"))
 526                              (if (> (length input) 0)
 527                                  (progn
 528                                    (setq input (substring input 0 (1- (length input))))
 529                                    (setq wlist (replay-criterions current-criterion))
 530                                    (iswitch-update-match input init-wlist))
 531                                (progn
 532                                  (setq current-criterion (safe-cdr current-criterion))
 533                                  (setq wlist (replay-criterions current-criterion)) ;init-wlist is recomputed! that's good.
 534                                  )))
 535
 536                             ;; should be a common ...
 537                                         ; (setq wlist (iswitch-update-match (cons input constraints) init-wlist)))
 538                             ((equal key "M-e")
 539                              (iswitch-add-condition! wlist '(class "Emacs")))
 540
 541
 542
 543                             ;; do i want alist ??
 544                             ;; should be a common ...
 545                             ((or (equal key "C-w") ; limit to the current workspace:
 546                                  (equal key "H-w"))
 547                              ;; should be a common ...
 548                              (iswitch-add-condition! wlist (list 'workspace current-workspace)))
 549
 550                             ((equal key "M-f")
 551                                         ;(setq wlist (iswitch-update-class wlist '("Emacs")))
 552                              (setq wlist
 553                                    (iswitch-add-condition
 554                                     (iswitch-add-condition wlist '(class "Emacs" "xemacs"))
 555                                     '(name "xemacs"))))
 556
 557
 558                             ((equal key "M-t")
 559                              (iswitch-add-condition! wlist '(class "XTerm")))
 560
 561                             ;((equal key "M-g")
 562                             ; (setq wlist (iswitch-update-class wlist '("galeon_browser"))))
 563
 564                             ((equal key "M-g")
 565                              (iswitch-add-condition! wlist '(class "gauche"))
 566                              ;(setq wlist (iswitch-update-class wlist '("gauche")))
 567                              )
 568
 569                             ((equal key "C-k")
 570                              (iswitch-add-condition! wlist `(predicate ,window-iconified-p)))
 571
 572                             ((equal key "M-c")
 573                              (setq wlist (iswitch-update-class wlist '("X-Chat"))))
 574
 575
 576
 577                             ((equal key "M-u")
 578                              ;;(setq wlist (iswitch-update-class wlist '("X-Chat")))
 579                              ;; prompt-for-user
 580                              )
 581
 582                             ((equal key "M-r")
 583                                         ;(setq wlist (iswitch-update-class wlist '("X-Chat")))
 584                              ;; prompt-for-user
 585                              )
 586
 587                             ((equal key "M-l")
 588                              ;;
 589                              (iswitch-add-condition! wlist '(class "XTerm"))
 590                              (iswitch-add-condition! wlist '(name "Elinks")))
 591
 592                             ;;"navigator:browser"
 593                             ;;"Mozilla-bin"
 594                             ((equal key "M-m")
 595                              (iswitch-add-condition!
 596                               wlist
 597                               '(class
 598                                 "Mozilla" ; -bin"
 599                                 "Mozilla-bin"
 600                                 "navigator:browser"
 601                                 "MozillaFirebird-bin"
 602                                 "Firefox-bin")))
 603                                         ;"galeon_browser"
 604
 605
 606                             ((equal key "C-v") ; limit to the current viewport
 607                              ;; fixme!
 608                              (iswitch-add-condition!
 609                               wlist
 610                               `(viewport ,current-workspace)))
 611
 612
 613                             ((equal key "C-o") ; limit to the current viewport
 614                              ;; fixme!
 615                              (iswitch-add-condition!
 616                               wlist
 617                               `(workspace (not . ,current-workspace))))
 618
 619
 620                             ((equal key "C-s")
 621                              (setq current-search wlist))
 622                             ;; Rotations:
 623                             ((or
 624                               (equal key "A-s")
 625                               (equal key "C-i")
 626                               (equal key "C-p")
 627                               (equal key "Down")
 628                               (equal key "TAB"))
 629                              (setq use-timer #f)
 630                              (setq wlist (iswitch-rotate-to-next-match input wlist)))
 631                             ((or (equal key "C-r")
 632                                  (equal key "A-r")
 633                                  (equal key "M-i")
 634                                  (equal key "Up")
 635                                  (equal key "C-n")
 636                                  (equal key "M-TAB"))
 637                              (setq use-timer #f)
 638                              (setq wlist (iswitch-rotate-to-next-match input wlist t)))
 639                             ;; Go
 640                             ((or (equal key "RET")
 641                                  (equal key "C-m"))
 642
 643                              (unless (string= input "")
 644                                (push! current-criterion `(name ,input)))
 645                              (setq current-search wlist)
 646                              (throw 'exit-iswitch wlist))
 647
 648                             ((or (equal key "C-j")) ; push this constraint
 649                              (iswitch-add-condition! wlist `(name ,input))
 650                              (setq input ""))
 651
 652                             ((or (equal key "M-h")) ; push this constraint
 653                                         ;(get-x-text-property (input-focus) 'WM_CLIENT_MACHINE)
 654                              (if display-timer
 655                                  (delete-timer display-timer))
 656                              (let ((host (prompt-for-host)))
 657                                ;(display-message host)
 658                                (iswitch-add-condition! wlist `(host ,host))))
 659
 660
 661                          ;;; These don't `modify' the wlist:
 662
 663                             ;; Some handy ops, once we are there why not to ... toggle some
 664                             ((or (equal key "C-z")
 665                                  (equal key "A-z"))
 666                              (let ((w (car wlist)))
 667                                (if (window-get w 'iconified)
 668                                    (uniconify-window w)
 669                                  (iconify-window w))))
 670
 671                             ((or        ;(equal key "C-h")
 672                                         ;(equal key "A-h")
 673                               (equal key "M-s"))
 674                              (toggle-window-shaded (car wlist)))
 675
 676
 677                             ;; "C-f" "C-b" ??
 678
 679
 680                             ;; append ... `chars' only !
 681                             ((or        ;(equal key "SPC")
 682                               (= 1 (length event-string))) ; sawfish.wm.events
 683                              (setq input (concat input event-string)
 684                                    wlist (iswitch-update-match input wlist))))
 685
 686                       (when (= 1 (length wlist))
 687                         (beep)
 688                                         ;(throw 'exit-iswitch wlist)
 689                         (display-window (car wlist))))))))
 690
 691            ;; unwind-protect:
 692            (display-message nil)
 693            (x-message-hide iswitch-display-window)
 694            (if display-timer
 695                (delete-timer display-timer)))))))
 696
 697
 698 ;; Enter iswitch, but at first limit by host:
 699 (define (iswitch-start-host)
 700   (let ((host (prompt-for-host)))
 701     (display-window
 702      (safe-car (iswitch-get-windows
 703                                         ;(display-message host)
 704                 `((host ,host))))
 705     )))
 706
 707 (define-command 'iswitch-start-host iswitch-start-host)
 708
 709                                         ; (ungrab-keyboard-soft)
 710 (define (iswitch-get-window)
 711     (safe-car (iswitch-get-windows '())))
 712
 713 ;;; hi level
 714   (define (iswitch-window)
 715     "Pick a window by incremental search and select it." ;(interactive)
 716     (display-window (iswitch-get-window)))
 717
 718
 719
 720
 721 ;; maybe it's useful to just fix a search/set of windows ?
 722 ;; Note, that the set-of-windows is not updated!!!
 723   (define (make-search)
 724     (setq current-search (iswitch-get-windows '())))
 725
 726 ;; But i would like to have such named searches ??
 727
 728
 729
 730 ;;; Commands:
 731   (define-command 'make-search make-search) ; Is it used?
 732
 733   (define-command 'iswitch-window iswitch-window)
 734
 735   (define-command 'iswitch-window-continue
 736     (lambda ()
 737       (display-window
 738        (safe-car (iswitch-get-windows current-criterion)))))
 739
 740
 741   (define-command 'iswitch-window-here
 742     (lambda ()
 743       (display-window
 744        (safe-car (iswitch-get-windows `((workspace ,current-workspace)))))))
 745
 746 ;; ??? this should be an interactive  #:spec   !
 747   (define (iswitch-window-with act)
 748     "Pick a window by incremental search, select it and ACT on previous."
 749                                         ;(interactive)
 750     (let ((old (car (window-order)))
 751           (new (iswitch-get-window)))
 752       (when new
 753         (unless (or (eq new old)
 754                     (window-get old 'sticky)
 755                     (window-outside-viewport-p new))
 756           (act old))
 757         (display-window new)))))
 758
 759 ;; todo:  colored display.
 760 ;(window-class (get-window-by-name-re "X-Chat"))