parley escape handlers refactoring pasted by DerGuteMoritz on Mon Apr 16 21:45:17 2012
Index: parley.scm =================================================================== --- parley.scm (revision 26514) +++ parley.scm (working copy) @@ -351,25 +351,27 @@ (list prompt in out line (string-length line) exit offset))) (escape-sequence . ,(lambda (prompt in out line pos exit offset) - (cond ((get-complete-esc-sequence in) => - (lambda (seq) - (cond ((alist-ref seq user-esc-sequences) => - (lambda (e) (e prompt in out line pos exit offset))) - (else - (case (cadr seq) - ((#\x43) ((handle 'right-arrow) prompt in out line pos exit offset)) - ((#\x44) ((handle 'left-arrow) prompt in out line pos exit offset)) - ((#\x41) ((handle 'prev-history) prompt in out line pos exit offset)) - ((#\x42) ((handle 'next-history) prompt in out line pos exit offset)) - (else - (list prompt in out line pos exit offset))))))) - (else (list prompt in out line pos exit offset))))))) + (let ((seq (get-complete-esc-sequence in))) + (cond ((escape-sequence-handler-ref seq) => + (lambda (handler) + (handler prompt in out line pos exit offset))) + (else (list prompt in out line pos exit offset)))))))) (define (handle event) (cond ((alist-ref event +key-handlers+) => identity) (else (error "Unhandled event " event)))) +(define +escape-sequence-handlers+ + `((#\x43 . ,(handle 'right-arrow)) + (#\x44 . ,(handle 'left-arrow)) + (#\x41 . ,(handle 'prev-history)) + (#\x42 . ,(handle 'next-history)))) + +(define (escape-sequence-handler-ref seq) + (or (alist-ref seq user-esc-sequences) + (alist-ref seq +escape-sequence-handlers+))) + (define (refresh-line prompt port line pos offset) (let* ((cols (- (get-terminal-columns port) offset))
slightly better version pasted by DerGuteMoritz on Mon Apr 16 21:55:05 2012
Index: parley.scm =================================================================== --- parley.scm (revision 26514) +++ parley.scm (working copy) @@ -351,18 +351,9 @@ (list prompt in out line (string-length line) exit offset))) (escape-sequence . ,(lambda (prompt in out line pos exit offset) - (cond ((get-complete-esc-sequence in) => - (lambda (seq) - (cond ((alist-ref seq user-esc-sequences) => - (lambda (e) (e prompt in out line pos exit offset))) - (else - (case (cadr seq) - ((#\x43) ((handle 'right-arrow) prompt in out line pos exit offset)) - ((#\x44) ((handle 'left-arrow) prompt in out line pos exit offset)) - ((#\x41) ((handle 'prev-history) prompt in out line pos exit offset)) - ((#\x42) ((handle 'next-history) prompt in out line pos exit offset)) - (else - (list prompt in out line pos exit offset))))))) + (cond ((escape-sequence-handler-ref (get-complete-esc-sequence in)) => + (lambda (handler) + (handler prompt in out line pos exit offset))) (else (list prompt in out line pos exit offset))))))) (define (handle event) @@ -370,6 +361,16 @@ identity) (else (error "Unhandled event " event)))) +(define +escape-sequence-handlers+ + `((#\x43 . ,(handle 'right-arrow)) + (#\x44 . ,(handle 'left-arrow)) + (#\x41 . ,(handle 'prev-history)) + (#\x42 . ,(handle 'next-history)))) + +(define (escape-sequence-handler-ref seq) + (and seq (or (alist-ref seq user-esc-sequences) + (alist-ref seq +escape-sequence-handlers+)))) + (define (refresh-line prompt port line pos offset) (let* ((cols (- (get-terminal-columns port) offset))
parley C-l pasted by DerGuteMoritz on Tue Apr 17 10:18:45 2012
Index: parley.scm =================================================================== --- parley.scm (revision 26515) +++ parley.scm (working copy) @@ -147,8 +147,10 @@ ( move-forward . ,(lambda (n) (sprintf "\x1b[~aC" n))) ( move-backward . ,(lambda (n) (sprintf "\x1b[~aD" n))) ( move-to-col . ,(lambda (col) (sprintf "\x1b[~aG" col))) + ( move-to . ,(lambda (row col) (sprintf "\x1b[~a;~aH" row col))) ( save-position . ,(lambda () "\x1b[s")) - ( restore-position . ,(lambda () "\x1b[u")))) + ( restore-position . ,(lambda () "\x1b[u")) + ( erase-screen . ,(lambda (n) (sprintf "\x1b[~aJ" n))))) (define (esc-seq name) (cond ((alist-ref name +esc-sequences+) => @@ -294,7 +296,7 @@ (list prompt in out line pos exit offset))) (discard-and-restart . ,(lambda (prompt in out line pos exit offset) - (list prompt in out "" 0 exit offset))) + (list prompt in out "" 0 exit 0))) (delete-curr-char . ,(lambda (prompt in out line pos exit offset) (if (> pos 0) @@ -354,7 +356,11 @@ (cond ((escape-sequence-handler-ref (get-complete-esc-sequence in)) => (lambda (handler) (handler prompt in out line pos exit offset))) - (else (list prompt in out line pos exit offset))))))) + (else (list prompt in out line pos exit offset))))) + (erase-screen . ,(lambda (prompt in out line pos exit offset) + (display ((esc-seq 'erase-screen) 2) out) + (display ((esc-seq 'move-to) 1 1) out) + (list prompt in out line pos exit offset))))) (define (handle event) (cond ((alist-ref event +key-handlers+) => @@ -365,7 +371,8 @@ `((#\x43 . ,(handle 'right-arrow)) (#\x44 . ,(handle 'left-arrow)) (#\x41 . ,(handle 'prev-history)) - (#\x42 . ,(handle 'next-history)))) + (#\x42 . ,(handle 'next-history)) + (#\x4a . ,(handle 'erase-screen)))) (define (escape-sequence-handler-ref seq) (and seq (or (alist-ref seq user-esc-sequences) @@ -439,6 +446,8 @@ (handle 'escape-sequence)) ((#\xb) (handle 'delete-until-eol)) + ((#\xc) + (handle 'erase-screen)) ((#\x1) (handle 'jump-to-start-of-line)) ((#\x5)
C-l handling 2.0 pasted by DerGuteMoritz on Tue Apr 17 10:35:56 2012
Index: parley.scm =================================================================== --- parley.scm (revision 26515) +++ parley.scm (working copy) @@ -147,8 +147,10 @@ ( move-forward . ,(lambda (n) (sprintf "\x1b[~aC" n))) ( move-backward . ,(lambda (n) (sprintf "\x1b[~aD" n))) ( move-to-col . ,(lambda (col) (sprintf "\x1b[~aG" col))) + ( move-to . ,(lambda (row col) (sprintf "\x1b[~a;~aH" row col))) ( save-position . ,(lambda () "\x1b[s")) - ( restore-position . ,(lambda () "\x1b[u")))) + ( restore-position . ,(lambda () "\x1b[u")) + ( erase-screen . ,(lambda (n) (sprintf "\x1b[~aJ" n))))) (define (esc-seq name) (cond ((alist-ref name +esc-sequences+) => @@ -354,7 +356,11 @@ (cond ((escape-sequence-handler-ref (get-complete-esc-sequence in)) => (lambda (handler) (handler prompt in out line pos exit offset))) - (else (list prompt in out line pos exit offset))))))) + (else (list prompt in out line pos exit offset))))) + (erase-screen . ,(lambda (prompt in out line pos exit offset) + (display ((esc-seq 'erase-screen) 2) out) + (display ((esc-seq 'move-to) 1 1) out) + (list prompt in out line pos exit offset))))) (define (handle event) (cond ((alist-ref event +key-handlers+) => @@ -439,6 +445,8 @@ (handle 'escape-sequence)) ((#\xb) (handle 'delete-until-eol)) + ((#\xc) + (handle 'erase-screen)) ((#\x1) (handle 'jump-to-start-of-line)) ((#\x5)
fixes for fixes added by C-Keen on Tue Apr 17 10:52:59 2012
Index: parley.scm =================================================================== --- parley.scm (revision 26522) +++ parley.scm (working copy) @@ -374,8 +374,8 @@ (#\x42 . ,(handle 'next-history)))) (define (escape-sequence-handler-ref seq) - (and seq (or (alist-ref seq user-esc-sequences) - (alist-ref seq +escape-sequence-handlers+)))) + (and seq (or (alist-ref (second seq) user-esc-sequences equal?) + (alist-ref (second seq) +escape-sequence-handlers+ equal?)))) (define (refresh-line prompt port line pos offset) (let* ((cols (- (get-terminal-columns port)