Changeset 25468 in project


Ignore:
Timestamp:
10/30/11 14:06:29 (9 years ago)
Author:
Christian Kellermann
Message:

parley: fix bug 721 and improve pasting

This fixes:

  • preservance of newlines for dumb terminal usage (e.g. piping input to csi) -> bug 721
  • Before determining the column offset all existing input is now preserved and fed to the parsing procedure afterwards. This fixes pasting but csi's repl my look a but unfamliliar:

#;1> 1
1
#;2> 2
#;2> 3
#;2> 4
2
3
4
#;5>

History is preserved correctly.

  • simple comments are now ignored by the input-missing? procedure. Block comments and #; syntax are not (yet).
File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/parley/trunk/parley.scm

    r24839 r25468  
    5757         make-parley-port
    5858         parley
     59         parley-debug
    5960         terminal-supported?)
    6061
    6162        (import chicken scheme)
    6263        (use data-structures extras ports posix srfi-1 srfi-13 srfi-18 stty)
     64
     65        (define parley-debug (make-parameter #f))
     66
     67        (define-syntax dbg
     68          (syntax-rules ()
     69            ((_ fmt ...) (if (parley-debug) (fprintf (current-error-port) fmt ...)))))
     70
    6371
    6472        (define history-max-lines (make-parameter 100))
     
    95103          (let ((real-port (first-usable-port port plist)))
    96104            (unless (char-ready? port)
    97               (thread-wait-for-i/o! (port->fileno port) #:input))
     105              (thread-wait-for-i/o! (port->fileno real-port) #:input))
    98106            (read-char port)))
    99107
     
    102110                     (c (read-one-char port)))
    103111            (cond ((equal? c #\newline)
    104                    (list->string (reverse l)))
     112                   (list->string (reverse (cons c l))))
    105113                  ((eof-object? c) #!eof)
    106114                  (else
     
    136144          `(( cur-left-edge  . ,(lambda () "\x1b[0G"))
    137145            ( erase-to-right . ,(lambda () "\x1b[0K"))
    138             ( move-to-col . ,(lambda (col) (sprintf "\x1b[~aG" col)))))
     146            ( move-forward   . ,(lambda (n) (sprintf "\x1b[~aC" n)))
     147            ( move-backward  . ,(lambda (n) (sprintf "\x1b[~aD" n)))
     148            ( move-to-col    . ,(lambda (col) (sprintf "\x1b[~aG" col)))
     149            ( save-position  . ,(lambda () "\x1b[s"))
     150            ( restore-position . ,(lambda () "\x1b[u"))))
    139151
    140152        (define (esc-seq name)
     
    248260                  (res (list res c))
    249261                  (else #f))))
     262
     263        (define (slurp-all-input port)
     264          (let loop ((r '()))
     265            (if (char-ready? port)
     266                (loop (cons (read-one-char port) r))
     267                (reverse r))))
    250268
    251269        (define (get-column port)
     
    391409                              (return line))
    392410                             ((#!eof #\x04)
    393                               (display "^D" out)
    394411                              (if (string-null? line)
    395                                   (return #!eof)
     412                                  (begin
     413                                    (display "^D" out)
     414                                    (return #!eof))
    396415                                  (begin
    397416                                    (newline out)
     
    440459            (history-add! l)))
    441460
     461        (define (useful-term? port)
     462          (terminal-supported?
     463           (first-usable-port port port-list)
     464           (get-environment-variable "TERM")))
    442465
    443466        (define (parley prompt #!key (in ##sys#standard-input) (out (current-output-port)))
     
    446469                 (real-in-port (first-usable-port in port-list))
    447470                 (useful-term (terminal-supported? real-in-port (get-environment-variable "TERM")))
    448                  (old-attrs (and useful-term (enable-raw-mode real-in-port)))
    449                  (line (if useful-term
    450                            (begin
    451                              (history-init!)
    452                              (unless (member in port-list)
    453                                (set! port-list (cons in port-list)))
    454                              (let ((offset (if parley-port 1 (get-column real-in-port))))
    455                                (read-raw prompt real-in-port out offset)))
    456                            (begin
    457                              ;(print "; Warning: dumb terminal")
    458                              (set-buffering-mode! real-in-port #:none)
    459                              (when (or (terminal-port? in)
    460                                        parley-port)
    461                                (display prompt out))
    462                              (flush-output out)
    463                              (let ((l (read-one-line real-in-port)))
    464                                l)))))
    465             (if old-attrs (restore-terminal-settings real-in-port old-attrs))
    466             line))
     471                 (old-attrs (and useful-term (enable-raw-mode real-in-port))))
     472            (let ((lines (if useful-term
     473                             (begin
     474                               (history-init!)
     475                               (unless (member in port-list)
     476                                 (set! port-list (cons in port-list)))
     477                               (let* ((prev-input (and (char-ready? in) (slurp-all-input in)))
     478                                      (offset (if parley-port 1 (get-column real-in-port))))
     479                                 (if prev-input
     480                                     (call-with-input-string
     481                                         (list->string prev-input)
     482                                       (lambda (in)
     483                                         (let loop ((r '()))
     484                                           (if (eof-object? (peek-char in))
     485                                               (reverse r)
     486                                               (loop (cons (read-raw prompt in out offset) r))))))
     487                                     (read-raw prompt real-in-port out offset))))
     488                             (begin
     489                               (dbg "; Warning: dumb terminal")
     490                               (set-buffering-mode! real-in-port #:none)
     491                               (when (or (terminal-port? in)
     492                                         parley-port)
     493                                 (display prompt out))
     494                               (flush-output out)
     495                               (let ((l (read-one-line real-in-port)))
     496                                 l)))))
     497              (if old-attrs (restore-terminal-settings real-in-port old-attrs))
     498              lines)))
    467499
    468500        (define (input-missing? line)
     
    477509                  (str (wtl (cdr lst) (equal? (car lst) #\\) parens brackets (not (equal? (car lst) #\")) #f))
    478510                  (else (case (car lst)
     511                          ((#\;) (let (( r (drop-while (lambda (c) (not (equal? c #\newline))) lst)))
     512                                   (wtl (if (pair? r) (cdr r) r)  #f parens brackets str #f)))
    479513                          ((#\\) (wtl (cdr lst) #t parens brackets str #f))
    480514                          ((#\") (wtl (cdr lst) #f parens brackets (not str) #f))
     
    486520                          (else (wtl (cdr lst) esc parens brackets str #f))))))
    487521          (wtl (string->list line) #f 0 0 #f #f))
    488 
    489522
    490523        (define (make-parley-port in #!optional prompt prompt2)
     
    498531            (letrec ((append-while-incomplete
    499532                      (lambda (start)
    500                         (let* ((line (parley (if (string-null? start)
     533                        (let* ((lines (parley (if (string-null? start)
    501534                                                 (or p1 ((repl-prompt)))
    502535                                                 p2)
    503536                                          in: in))
     537                               (line (if (list? lines) (string-intersperse lines (string #\newline)) lines))
    504538                               (res (and (string? line) (string-append start line))))
    505539                          (cond ((and (eof-object? line) (string-null? start)) line)
     
    524558                               (set! l
    525559                                     (append-while-incomplete ""))
    526                                (if (string? l)
     560                               (if (and (useful-term? in) (string? l))
    527561                                     (set! l (string-append l "\n")))
    528562                               (if (not (eof-object? l))
Note: See TracChangeset for help on using the changeset viewer.