history-lines now independent from window-size
This commit is contained in:
chetz
parent
475177b891
commit
8ec647be9e
|
|
@ -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)))))))
|
||||
|
||||
Loading…
Reference in New Issue