diff --git a/src/file-name-completion.scm b/src/file-name-completion.scm new file mode 100644 index 0000000..2edcc33 --- /dev/null +++ b/src/file-name-completion.scm @@ -0,0 +1,25 @@ + +(define *cache* #f) + +(define (executables-in-path) + (or *cache* + (begin + (set! *cache* (executables-in-path-list (thread-fluid exec-path-list))) + *cache*))) + +(define (executables-in-path-list path-list) + (append-map! dir-executables path-list)) + +(define (dir-executables dir) + (if (file-readable? dir) + (map file-name-nondirectory + (filter executable? (glob (string-append dir "/*")))) + '())) + +(define (executable? name) + (with-errno-handler + ((errno packet) + (else #f)) + (let ((info (file-info name))) + (and (file-info-executable? info) + (file-info-regular? info))))) \ No newline at end of file diff --git a/src/packages.scm b/src/packages.scm index 864d37f..de8e27e 100644 --- a/src/packages.scm +++ b/src/packages.scm @@ -79,6 +79,13 @@ utils) (files button)) +(define-structure file-name-completion + (export executables-in-path) + (open scheme-with-scsh + srfi-1 + thread-fluids) + (files file-name-completion)) + ;; *** key-grab ****************************************************** (define-structure key-grab @@ -215,7 +222,7 @@ utils key-grab manager move-wm split-wm switch-wm - prompt) + prompt file-name-completion) (files root-manager)) (define-structure main diff --git a/src/root-manager.scm b/src/root-manager.scm index 13f4db6..42bf095 100644 --- a/src/root-manager.scm +++ b/src/root-manager.scm @@ -316,9 +316,10 @@ (exec (prompt (root-wm:dpy root-wm) (wm:window cm) (get-option-value (root-wm:options root-wm) 'execute-question) - #f exec-complete))) - (if exec - (run (sh -c ,(string-append exec " &")))))) + #f (finite-complete (executables-in-path))))) + (and exec + (not (string=? exec "")) + (run (sh -c ,(string-append exec " &")))))) ((attach) (let* ((cm (root-wm:current-manager root-wm)) (windows-above (window-path (wm:dpy cm) (wm:window cm))) @@ -366,10 +367,6 @@ (else (warn "unknown binding command" command)))) (warn "unhandled root message" msg))))) -(define (exec-complete str pos) - ;; TODO - (cons str pos)) - (define (finite-complete strings) (lambda (str pos) (let* ((s (substring str 0 pos))