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

88
scheme/command-buffer.scm
View File

@ -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)
@ -253,6 +250,7 @@
(let ((new-input-field-y-dim (max 1
(- (command-buffer-y-dim com-buf)
(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)))))
@ -324,6 +323,7 @@
(let* ((new-input-field-y-dim (max needed-y-dim
(- (command-buffer-y-dim com-buf)
(length (history-lines-from-history
com-buf
(command-buffer-y-dim com-buf))))))
(move-input-field (lambda ()
(input-field-move input-field
@ -349,6 +349,7 @@
(let* ((new-input-field-y-dim (max 1
(- (command-buffer-y-dim com-buf)
(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)))))))