Add a "result screen" for showing the output of external programs.

This commit is contained in:
eknauel 2005-05-27 16:02:39 +00:00
parent 84b5fec438
commit 4a85644f58
3 changed files with 60 additions and 5 deletions

View File

@ -132,7 +132,6 @@
(current-history-entry-selector-maker history-entry-result)) (current-history-entry-selector-maker history-entry-result))
(define (update-current-result! new-value) (define (update-current-result! new-value)
(debug-message "update-current-result! " new-value)
(cond (cond
((current-history-item) ((current-history-item)
=> (lambda (entry) => (lambda (entry)
@ -295,11 +294,27 @@
(toggle-command/scheme-mode) (toggle-command/scheme-mode)
(loop (wait-for-input) #f)) (loop (wait-for-input) #f))
((= ch key-f8)
(show-shell-screen)
(paint)
(loop (wait-for-input) #f))
;; C-x o --- toggle buffer focus ;; C-x o --- toggle buffer focus
((and c-x-pressed? (= ch key-o)) ((and c-x-pressed? (= ch key-o))
(toggle-buffer-focus) (toggle-buffer-focus)
(loop (wait-for-input) #f)) (loop (wait-for-input) #f))
;; C-x p --- insert selection
((and c-x-pressed?
(focus-on-command-buffer?)
(current-history-item)
(= ch 112))
(add-string-to-command-buffer
(post-message
(history-entry-plugin (entry-data (current-history-item)))
(make-selection-message (active-command) (current-result))))
(loop (wait-for-input) #f))
((and c-x-pressed? (focus-on-result-buffer?)) ((and c-x-pressed? (focus-on-result-buffer?))
(let ((key-message (let ((key-message
(make-key-pressed-message (make-key-pressed-message
@ -493,7 +508,6 @@
(refresh-command-window)) (refresh-command-window))
(define (paint) (define (paint)
(debug-message "paint")
(paint-bar-1) (paint-bar-1)
(paint-command-frame-window) (paint-command-frame-window)
(paint-command-window-contents) (paint-command-window-contents)
@ -672,9 +686,11 @@
(wrefresh win))) (wrefresh win)))
(define (paint-result-buffer paint-proc) (define (paint-result-buffer paint-proc)
(debug-message "paint-result-buffer before")
(paint-proc (app-window-curses-win result-window) (paint-proc (app-window-curses-win result-window)
result-buffer result-buffer
(focus-on-result-buffer?))) (focus-on-result-buffer?))
(debug-message "paint-result-buffer after"))
;;Cursor ;;Cursor
;;move cursor to the corrct position ;;move cursor to the corrct position

View File

@ -106,8 +106,12 @@
;;; standard command plugin ;;; standard command plugin
(define-structure standard-command-plugin (define-structure standard-command-plugin
(export standard-command-plugin) (export standard-command-plugin show-shell-screen)
(open nuit-eval (open nuit-eval
let-opt
pps
ncurses
signals
plugin) plugin)
(files std-command)) (files std-command))
@ -175,6 +179,7 @@
srfi-1 srfi-1
srfi-6 srfi-6
display-conditions display-conditions
signals
ncurses ncurses
layout layout

View File

@ -1,8 +1,36 @@
;; ,open let-opt
(define (wait-for-key . optionals)
(let-optionals optionals
((tty-port (current-input-port)))
(let* ((old (tty-info tty-port))
(copy (copy-tty-info old)))
(set-tty-info:local-flags
copy
(bitwise-and (tty-info:local-flags copy)
(bitwise-not ttyl/canonical)))
(set-tty-info:min copy 1)
(set-tty-info:time copy 0)
(set-tty-info/now tty-port copy)
(let ((c (read-char tty-port)))
(set-tty-info/now tty-port old)
c))))
(define (standard-command-plugin-completer command args) (define (standard-command-plugin-completer command args)
#f) #f)
(define (show-shell-screen)
(def-prog-mode)
(endwin)
(display "Press any key to return to scsh-nuit...")
(wait-for-key))
(define (standard-command-plugin-evaluater command args) (define (standard-command-plugin-evaluater command args)
(run/strings (,command ,@args))) (def-prog-mode)
(endwin)
(let ((status (run (,command ,@args))))
(display "Press any key to return to scsh-nuit...")
(wait-for-key)
status))
(define standard-command-plugin (define standard-command-plugin
(make-command-plugin #f (make-command-plugin #f
@ -19,6 +47,12 @@
(lambda (command args) (lambda (command args)
(directory-files)))) (directory-files))))
(register-plugin!
(make-command-plugin "ps"
no-completer
(lambda (command args)
(pps))))
(register-plugin! (register-plugin!
(make-command-plugin "pwd" (make-command-plugin "pwd"
no-completer no-completer