From 8ec647be9ec16bc9e91486a838c2e49d4121115e Mon Sep 17 00:00:00 2001 From: chetz Date: Wed, 29 Mar 2006 12:44:42 +0000 Subject: [PATCH] history-lines now independent from window-size --- scheme/command-buffer.scm | 94 +++++++++++++++++++++++---------------- 1 file changed, 55 insertions(+), 39 deletions(-) diff --git a/scheme/command-buffer.scm b/scheme/command-buffer.scm index 95e28b7..0ea5a84 100644 --- a/scheme/command-buffer.scm +++ b/scheme/command-buffer.scm @@ -11,21 +11,24 @@ *current-command-history-item*) (define-record-type command-history-entry :command-history-entry - (make-command-history-entry prompt window-lines) + (make-command-history-entry prompt text) command-history-entry? (prompt command-history-entry-prompt) - (window-lines command-history-entry-window-lines)) + (text command-history-entry-text)) (define input-field->command-history-item (lambda (input-field) (let* ((prompt (input-field-prompt input-field)) - (w-l (map list->string - (input-field-window-lines input-field))) - (window-lines (cons (substring (car w-l) - (string-length prompt) - (string-length (car w-l))) - (cdr w-l)))) - (make-command-history-entry prompt window-lines)))) + (prompt+texts (map list->string + (input-field-window-lines input-field))) + (texts (cons (substring (car prompt+texts) + (string-length prompt) + (string-length (car prompt+texts))) + (cdr prompt+texts))) + (text (fold-right string-append + "" + texts))) + (make-command-history-entry prompt text)))) (define (append-to-command-history! history-entry) (append-history-item! the-command-history history-entry) @@ -63,22 +66,18 @@ (set-command-buffer-keep-in-mind! com-buf (input-field-text (command-buffer-input-field com-buf))) (set-command-buffer-text! com-buf - (fold-right string-append - "" - (command-history-entry-window-lines - (entry-data *current-command-history-item*))))) - (let ((current-window-lines (command-history-entry-window-lines + (command-history-entry-text + (entry-data *current-command-history-item*)))) + (let ((current-window-text (command-history-entry-text (entry-data *current-command-history-item*)))) (command-history-back!) (set-command-buffer-text! com-buf - (fold-right string-append - "" - (command-history-entry-window-lines - (entry-data *current-command-history-item*)))) + (command-history-entry-text + (entry-data *current-command-history-item*))) (if (and (not (eq? *current-command-history-item* (history-first-entry (command-history)))) - (equal? current-window-lines - (command-history-entry-window-lines + (equal? current-window-text + (command-history-entry-text (entry-data *current-command-history-item*)))) (history-up com-buf) (values)))) @@ -95,16 +94,14 @@ (if (command-buffer-keep-in-mind com-buf) (set-command-buffer-text! com-buf (command-buffer-keep-in-mind com-buf))) (set! *history-down?* #t)) - (let ((current-window-lines (command-history-entry-window-lines + (let ((current-window-text (command-history-entry-text (entry-data *current-command-history-item*)))) (command-history-forward!) (set-command-buffer-text! com-buf - (fold-right string-append - "" - (command-history-entry-window-lines - (entry-data *current-command-history-item*)))) - (if (equal? current-window-lines - (command-history-entry-window-lines + (command-history-entry-text + (entry-data *current-command-history-item*))) + (if (equal? current-window-text + (command-history-entry-text (entry-data *current-command-history-item*))) (history-down com-buf) (values)))) @@ -153,11 +150,11 @@ (define buffer-pos-col (lambda (com-buf) (let ((input-field (command-buffer-input-field com-buf))) - (- (input-field-x-edit-pos input-field) - (string-length (input-field-prompt input-field)))))) + (- (input-field-x-edit-pos input-field) + (string-length (input-field-prompt input-field)))))) (define history-lines-from-history - (lambda (n) + (lambda (com-buf n) (let loop ((current-entry (history-last-entry (command-history))) (n n) (history-lines '())) @@ -165,10 +162,9 @@ (not current-entry)) history-lines (let* ((current-item (entry-data current-entry)) - (new-lines-wo-prompt (command-history-entry-window-lines current-item)) - (new-lines (cons (string-append (command-history-entry-prompt current-item) - (car new-lines-wo-prompt)) - (cdr new-lines-wo-prompt))) + (new-lines (split-to-string-list (string-append (command-history-entry-prompt current-item) + (command-history-entry-text current-item)) + (command-buffer-x-dim com-buf))) (new-n (- n (length new-lines)))) (loop (history-prev-entry current-entry) new-n @@ -185,7 +181,8 @@ (x-loc (command-buffer-x-loc com-buf)) (y-loc (command-buffer-y-loc com-buf)) (x-dim (command-buffer-x-dim com-buf)) - (history-lines (history-lines-from-history (+ (command-buffer-y-dim com-buf) + (history-lines (history-lines-from-history com-buf + (+ (command-buffer-y-dim com-buf) (command-buffer-history-scroll com-buf)))) (history-lines-to (take history-lines (max (- (length history-lines) @@ -252,7 +249,8 @@ (set! *history-down?* #t) (let ((new-input-field-y-dim (max 1 (- (command-buffer-y-dim com-buf) - (length (history-lines-from-history + (length (history-lines-from-history + com-buf (command-buffer-y-dim com-buf)))))) (old-input-field (command-buffer-input-field com-buf))) (set-command-buffer-input-field! com-buf @@ -276,7 +274,8 @@ (define scroll-up-history-window-lines (lambda (com-buf) (let ((scroll (command-buffer-history-scroll com-buf))) - (if (< scroll (- (length (history-lines-from-history (+ scroll + (if (< scroll (- (length (history-lines-from-history com-buf + (+ scroll (command-buffer-y-dim com-buf)))) (- (command-buffer-y-dim com-buf) (input-field-y-size (command-buffer-input-field com-buf))))) @@ -323,7 +322,8 @@ (input-field-toggle-y-scroll input-field))) (let* ((new-input-field-y-dim (max needed-y-dim (- (command-buffer-y-dim com-buf) - (length (history-lines-from-history + (length (history-lines-from-history + com-buf (command-buffer-y-dim com-buf)))))) (move-input-field (lambda () (input-field-move input-field @@ -348,7 +348,8 @@ (lambda (com-buf prompt) (let* ((new-input-field-y-dim (max 1 (- (command-buffer-y-dim com-buf) - (length (history-lines-from-history + (length (history-lines-from-history + com-buf (command-buffer-y-dim com-buf)))))) (old-input-field (command-buffer-input-field com-buf)) (text (input-field-text old-input-field))) @@ -402,3 +403,18 @@ (list->string missing)) (loop (- len 1) (cons ch missing)))))) + +(define split-to-string-list + (lambda (str len) + (let loop ((lst '()) + (str str) + (str-len (string-length str))) + (if (<= str-len len) + (append lst (list str)) + (let ((new-str (substring str + len str-len))) + (loop (append lst (list (substring str + 0 len))) + new-str + (string-length new-str))))))) + \ No newline at end of file