Fix selectable position for paging - holymoly - A tor enabled gopher client written in CHICKEN scheme
(HTM) git clone git://vernunftzentrum.de/holymoly.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
(DIR) commit cddd2a01c2c8d8141a7ab4dbb4ddf32d7516f232
(DIR) parent 5f6abb19963fae3735af7db225352db2a2239f05
(HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
Date: Mon, 10 Sep 2018 14:01:44 +0200
Fix selectable position for paging
Diffstat:
holymoly.scm | 53 +++++++++++++++----------------
1 file changed, 26 insertions(+), 27 deletions(-)
---
(DIR) diff --git a/holymoly.scm b/holymoly.scm
@@ -66,13 +66,12 @@
(define main-win (make-parameter #f))
(define status-win (make-parameter #f))
-(define (pager lines #!key win use-cursor selectables (renderer identity))
+(define (pager lines #!key win use-cursor (selectables '()) (renderer identity))
(when (and use-cursor (or (not selectables) (null? selectables)))
(error "Usage of use-cursor without handing in selectables"))
(unless win
(error "Need window parameter"))
- (let ((pos 0)
- (nlines (length lines))
+ (let ((nlines (length lines))
(cursor 0))
(when use-cursor
(set! cursor (list->cursor selectables)))
@@ -80,7 +79,7 @@
(lambda (k)
(let loop ((newp 0))
(let* ((rows cols (getmaxyx win))
- (dlines (take (drop lines pos) (min (- nlines pos) rows))))
+ (dlines (take (drop lines newp) (min (- nlines newp) rows))))
(wclear win)
(let draw ((l dlines)
(i 0))
@@ -88,8 +87,8 @@
(mvwprintw win i 0 "~a" (if (>= (string-length (renderer (car l))) cols)
(string-take (renderer (car l)) (sub1 cols))
(renderer (car l))))
- (when (and use-cursor (= (+ pos i) (current-cursor cursor)))
- (let ((e (list-ref lines (+ pos i))))
+ (when (and use-cursor (= (+ newp i) (current-cursor cursor)))
+ (let ((e (list-ref lines (+ newp i))))
(new-status "~a" (entry->string e)))
(mvwchgat win i 0 -1 A_STANDOUT 0 #f))
(draw (cdr l) (add1 i))))
@@ -97,31 +96,31 @@
(loop (case (char->integer (getch))
((16 #x103) ; arrow up
(cond
- (use-cursor (prev-cursor! cursor) pos)
- (else (if (zero? pos) 0 (set! pos (sub1 pos))))))
+ (use-cursor (prev-cursor! cursor) newp)
+ (else (if (zero? newp) 0 (sub1 newp)))))
((14 #x102) ; arrow down
(cond
- (use-cursor (next-cursor! cursor) pos)
- (else (if (= pos nlines) pos (set! pos (add1 pos))))))
- ((#x106) (when use-cursor (set! cursor (list->cursor selectables))) (set! pos 0)) ; HOME
- ((#x168) (set! pos (max pos (- nlines pos rows)))) ; end
+ (use-cursor (next-cursor! cursor) newp)
+ (else (if (= newp nlines) newp (add1 newp)))))
+ ((#x106) (when use-cursor (set! cursor (list->cursor selectables))) 0) ; HOME
+ ((#x168) (max newp (- nlines newp rows))) ; end
((260) (k 'back))
- ((32)
- (set! pos (if (> (+ pos rows) nlines) pos (+ pos (sub1 rows))))
- (when use-cursor
- (let adjust-cursor! ()
- (cond ((> pos (current-cursor cursor))
- (next-cursor! cursor)
- (adjust-cursor!))
- ((< (+ pos (length dlines)) (current-cursor cursor))
- (prev-cursor! cursor)
- (adjust-cursor!)))))
- pos) ; space
- ((10 261) (when use-cursor (k (list-ref lines (current-cursor cursor)))) pos)
- ((263) (set! pos (if (< (- pos rows) 0) 0 (- pos (sub1 rows))))) ; backspace
+ ((32) (let* ((np (if (> (+ newp rows) nlines) newp (+ newp (sub1 rows))))
+ (nsteps left (partition (lambda (x) (< x np)) selectables)))
+ (when use-cursor
+ (set! cursor (list->cursor selectables))
+ (repeat (length nsteps) (next-cursor! cursor)))
+ np)) ; space
+ ((10 261) (when use-cursor (k (list-ref lines (current-cursor cursor)))) newp)
+ ((263) (let* ((np (if (< (- newp rows) 0) 0 (- newp (sub1 rows))))
+ (nsteps left (partition (lambda (x) (< x np)) selectables)))
+ (when use-cursor
+ (set! cursor (list->cursor selectables))
+ (repeat (length nsteps) (next-cursor! cursor)))
+ np)) ; backspace
((113) (k 'quit)) ; q
- ((#x47 #x67) (k (uristring->entry (get-user-input "New uri:" (entry->string (current-page))))) pos) ; G
- (else pos)))))))))
+ ((#x47 #x67) (k (uristring->entry (get-user-input "New uri:" (entry->string (current-page))))) newp) ; G
+ (else newp)))))))))
(define (get-user-input #!optional (prompt "Enter query:") (suggestion ""))
(let* ((l c (getmaxyx (stdscr)))