diff --git a/scheme/browse-directory-list.scm b/scheme/browse-directory-list.scm index ea44ed5..156648b 100644 --- a/scheme/browse-directory-list.scm +++ b/scheme/browse-directory-list.scm @@ -218,6 +218,23 @@ prepare-selection-for-command-mode) file-names))) + (define (make-focus-object-reference table obj) + (let ((id (add-focus-object table obj))) + `(focus-value ,id))) + + (define (get-focus-object self focus-object-table) + (let ((marked (select-list-get-selection select-list)) + (make-reference (lambda (obj) + (make-focus-object-reference + focus-object-table obj)))) + (if (null? marked) + (exp->string + (make-reference (select-list-selected-entry select-list))) + (string-append + "(list " + (string-join (map exp->string (map make-reference marked))) + ")")))) + (lambda (message) (cond ((eq? message 'paint) @@ -231,6 +248,9 @@ ((eq? message 'get-selection) get-selection) + + ((eq? message 'get-focus-object) + get-focus-object) (else (error "fsobjects-viewer unknown message" message))))))) diff --git a/scheme/focus.scm b/scheme/focus.scm new file mode 100644 index 0000000..fa15b3b --- /dev/null +++ b/scheme/focus.scm @@ -0,0 +1,18 @@ +(define-record-type focus-table :focus-table + (really-make-focus-table table count) + focus-table? + (table focus-table-table) + (count focus-table-count set-focus-table-count!)) + +(define (make-empty-focus-table) + (really-make-focus-table (make-integer-table) 0)) + +(define (add-focus-object focus-table object) + (let ((count (+ 1 (focus-table-count focus-table)))) + (table-set! + (focus-table-table focus-table) count object) + count)) + +(define (get-focus-object focus-table index) + (table-ref (focus-table-table focus-table) index)) + diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 8bf7269..ca4d8b4 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -51,6 +51,8 @@ (define executable-completions-lock (make-lock)) (define executable-completions #f) +(define focus-table (make-empty-focus-table)) + (define key-control-x 24) (define key-o 111) (define key-tab 9) @@ -281,6 +283,24 @@ ;; #### crufty (define split-command-line string-tokenize) +(define (paste-selection/refresh viewer) + (add-string-to-command-buffer + (send (current-viewer) 'get-selection (command-buffer-in-scheme-mode?))) + (print-command-buffer (app-window-curses-win command-window) + command-buffer) + (move-cursor command-buffer result-buffer) + (refresh-command-window)) + +(define (paste-focus-object/refresh viewer) + (add-string-to-command-buffer + (if (command-buffer-in-command-mode?) + (send (current-viewer) 'get-selection (command-buffer-in-scheme-mode?)) + (send (current-viewer) 'get-focus-object focus-table))) + (print-command-buffer (app-window-curses-win command-window) + command-buffer) + (move-cursor command-buffer result-buffer) + (refresh-command-window)) + ;; handle input (define (run) @@ -342,27 +362,15 @@ (loop (wait-for-input) #f #f)) ;; C-x p --- insert selection - ((and c-x-pressed? - (focus-on-command-buffer?) - (current-history-item) + ((and c-x-pressed? (current-history-item) (= ch 112)) - (add-string-to-command-buffer - (send (current-viewer) 'get-selection (command-buffer-in-scheme-mode?))) - (print-command-buffer (app-window-curses-win command-window) - command-buffer) - (move-cursor command-buffer result-buffer) - (refresh-command-window) + (paste-selection/refresh (current-viewer)) (loop (wait-for-input) #f #f)) - ((and c-x-pressed? (focus-on-result-buffer?) - (= ch 112)) - (add-string-to-command-buffer - (send (current-viewer) 'get-selection (command-buffer-in-scheme-mode?))) - (focus-command-buffer!) - (print-command-buffer (app-window-curses-win command-window) - command-buffer) - (move-cursor command-buffer result-buffer) - (refresh-command-window) + ;; C-x P --- insert focus object(s) + ((and c-x-pressed? (current-history-item) + (= ch 80)) + (paste-focus-object/refresh (current-viewer)) (loop (wait-for-input) #f #f)) ((and c-x-pressed? (focus-on-result-buffer?)) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index a95e810..d1476de 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -118,6 +118,7 @@ signals let-opt + focus-table objects layout fs-object @@ -287,16 +288,16 @@ ;;; focus table -; (define-interface focus-table-interface -; (export make-empty-focus-table -; add-focus-object -; get-focus-object)) +(define-interface focus-table-interface + (export make-empty-focus-table + add-focus-object + get-focus-object)) -; (define-structure focus-table focus-table-interface -; (open scheme -; define-record-types -; general-table) -; (files focus)) +(define-structure focus-table focus-table-interface + (open scheme + define-record-types + tables) + (files focus)) ;;; completion-sets @@ -339,6 +340,7 @@ rt-modules tty-debug + focus-table fs-object objects plugin