scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

history-lines now independent from window-size

This commit is contained in:
chetz 2006-03-29 12:44:42 +00:00
parent 475177b891
commit 8ec647be9e
1 changed files with 55 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
scheme/command-buffer.scm
View File

@ -11,21 +11,24 @@
*current-command-history-item*) *current-command-history-item*)
(define-record-type command-history-entry :command-history-entry (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? command-history-entry?
(prompt command-history-entry-prompt) (prompt command-history-entry-prompt)
(window-lines command-history-entry-window-lines)) (text command-history-entry-text))
(define input-field->command-history-item (define input-field->command-history-item
(lambda (input-field) (lambda (input-field)
(let* ((prompt (input-field-prompt input-field)) (let* ((prompt (input-field-prompt input-field))
(w-l (map list->string (prompt+texts (map list->string
(input-field-window-lines input-field))) (input-field-window-lines input-field)))
(window-lines (cons (substring (car w-l) (texts (cons (substring (car prompt+texts)
(string-length prompt) (string-length prompt)
(string-length (car w-l))) (string-length (car prompt+texts)))
(cdr w-l)))) (cdr prompt+texts)))
(make-command-history-entry prompt window-lines)))) (text (fold-right string-append
""
texts)))
(make-command-history-entry prompt text))))
(define (append-to-command-history! history-entry) (define (append-to-command-history! history-entry)
(append-history-item! the-command-history history-entry) (append-history-item! the-command-history history-entry)
@ -63,22 +66,18 @@
(set-command-buffer-keep-in-mind! com-buf (set-command-buffer-keep-in-mind! com-buf
(input-field-text (command-buffer-input-field com-buf))) (input-field-text (command-buffer-input-field com-buf)))
(set-command-buffer-text! com-buf (set-command-buffer-text! com-buf
(fold-right string-append (command-history-entry-text
"" (entry-data *current-command-history-item*))))
(command-history-entry-window-lines (let ((current-window-text (command-history-entry-text
(entry-data *current-command-history-item*)))))
(let ((current-window-lines (command-history-entry-window-lines
(entry-data *current-command-history-item*)))) (entry-data *current-command-history-item*))))
(command-history-back!) (command-history-back!)
(set-command-buffer-text! com-buf (set-command-buffer-text! com-buf
(fold-right string-append (command-history-entry-text
"" (entry-data *current-command-history-item*)))
(command-history-entry-window-lines
(entry-data *current-command-history-item*))))
(if (and (not (eq? *current-command-history-item* (if (and (not (eq? *current-command-history-item*
(history-first-entry (command-history)))) (history-first-entry (command-history))))
(equal? current-window-lines (equal? current-window-text
(command-history-entry-window-lines (command-history-entry-text
(entry-data *current-command-history-item*)))) (entry-data *current-command-history-item*))))
(history-up com-buf) (history-up com-buf)
(values)))) (values))))
@ -95,16 +94,14 @@
(if (command-buffer-keep-in-mind com-buf) (if (command-buffer-keep-in-mind com-buf)
(set-command-buffer-text! com-buf (command-buffer-keep-in-mind com-buf))) (set-command-buffer-text! com-buf (command-buffer-keep-in-mind com-buf)))
(set! *history-down?* #t)) (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*)))) (entry-data *current-command-history-item*))))
(command-history-forward!) (command-history-forward!)
(set-command-buffer-text! com-buf (set-command-buffer-text! com-buf
(fold-right string-append (command-history-entry-text
"" (entry-data *current-command-history-item*)))
(command-history-entry-window-lines (if (equal? current-window-text
(entry-data *current-command-history-item*)))) (command-history-entry-text
(if (equal? current-window-lines
(command-history-entry-window-lines
(entry-data *current-command-history-item*))) (entry-data *current-command-history-item*)))
(history-down com-buf) (history-down com-buf)
(values)))) (values))))
@ -153,11 +150,11 @@
(define buffer-pos-col (define buffer-pos-col
(lambda (com-buf) (lambda (com-buf)
(let ((input-field (command-buffer-input-field com-buf))) (let ((input-field (command-buffer-input-field com-buf)))
(- (input-field-x-edit-pos input-field) (- (input-field-x-edit-pos input-field)
(string-length (input-field-prompt input-field)))))) (string-length (input-field-prompt input-field))))))
(define history-lines-from-history (define history-lines-from-history
(lambda (n) (lambda (com-buf n)
(let loop ((current-entry (history-last-entry (command-history))) (let loop ((current-entry (history-last-entry (command-history)))
(n n) (n n)
(history-lines '())) (history-lines '()))
@ -165,10 +162,9 @@
(not current-entry)) (not current-entry))
history-lines history-lines
(let* ((current-item (entry-data current-entry)) (let* ((current-item (entry-data current-entry))
(new-lines-wo-prompt (command-history-entry-window-lines current-item)) (new-lines (split-to-string-list (string-append (command-history-entry-prompt current-item)
(new-lines (cons (string-append (command-history-entry-prompt current-item) (command-history-entry-text current-item))
(car new-lines-wo-prompt)) (command-buffer-x-dim com-buf)))
(cdr new-lines-wo-prompt)))
(new-n (- n (length new-lines)))) (new-n (- n (length new-lines))))
(loop (history-prev-entry current-entry) (loop (history-prev-entry current-entry)
new-n new-n
@ -185,7 +181,8 @@
(x-loc (command-buffer-x-loc com-buf)) (x-loc (command-buffer-x-loc com-buf))
(y-loc (command-buffer-y-loc com-buf)) (y-loc (command-buffer-y-loc com-buf))
(x-dim (command-buffer-x-dim 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)))) (command-buffer-history-scroll com-buf))))
(history-lines-to (take history-lines (history-lines-to (take history-lines
(max (- (length history-lines) (max (- (length history-lines)
@ -252,7 +249,8 @@
(set! *history-down?* #t) (set! *history-down?* #t)
(let ((new-input-field-y-dim (max 1 (let ((new-input-field-y-dim (max 1
(- (command-buffer-y-dim com-buf) (- (command-buffer-y-dim com-buf)
(length (history-lines-from-history (length (history-lines-from-history
com-buf
(command-buffer-y-dim com-buf)))))) (command-buffer-y-dim com-buf))))))
(old-input-field (command-buffer-input-field com-buf))) (old-input-field (command-buffer-input-field com-buf)))
(set-command-buffer-input-field! com-buf (set-command-buffer-input-field! com-buf
@ -276,7 +274,8 @@
(define scroll-up-history-window-lines (define scroll-up-history-window-lines
(lambda (com-buf) (lambda (com-buf)
(let ((scroll (command-buffer-history-scroll 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))))
(- (command-buffer-y-dim com-buf) (- (command-buffer-y-dim com-buf)
(input-field-y-size (command-buffer-input-field com-buf))))) (input-field-y-size (command-buffer-input-field com-buf)))))
@ -323,7 +322,8 @@
(input-field-toggle-y-scroll input-field))) (input-field-toggle-y-scroll input-field)))
(let* ((new-input-field-y-dim (max needed-y-dim (let* ((new-input-field-y-dim (max needed-y-dim
(- (command-buffer-y-dim com-buf) (- (command-buffer-y-dim com-buf)
(length (history-lines-from-history (length (history-lines-from-history
com-buf
(command-buffer-y-dim com-buf)))))) (command-buffer-y-dim com-buf))))))
(move-input-field (lambda () (move-input-field (lambda ()
(input-field-move input-field (input-field-move input-field
@ -348,7 +348,8 @@
(lambda (com-buf prompt) (lambda (com-buf prompt)
(let* ((new-input-field-y-dim (max 1 (let* ((new-input-field-y-dim (max 1
(- (command-buffer-y-dim com-buf) (- (command-buffer-y-dim com-buf)
(length (history-lines-from-history (length (history-lines-from-history
com-buf
(command-buffer-y-dim com-buf)))))) (command-buffer-y-dim com-buf))))))
(old-input-field (command-buffer-input-field com-buf)) (old-input-field (command-buffer-input-field com-buf))
(text (input-field-text old-input-field))) (text (input-field-text old-input-field)))
@ -402,3 +403,18 @@
(list->string missing)) (list->string missing))
(loop (- len 1) (loop (- len 1)
(cons ch missing)))))) (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)))))))