Fix selectable position for paging - holymoly - A tor enabled gopher client wri… | |
git clone git://vernunftzentrum.de/holymoly.git | |
Log | |
Files | |
Refs | |
README | |
LICENSE | |
--- | |
commit cddd2a01c2c8d8141a7ab4dbb4ddf32d7516f232 | |
parent 5f6abb19963fae3735af7db225352db2a2239f05 | |
Author: Christian Kellermann <[email protected]> | |
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(-) | |
--- | |
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 … | |
(string-take (renderer (car l… | |
(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 curso… | |
+ (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 select… | |
- ((#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 select… | |
+ ((#x168) (max newp (- nlines newp rows))) ; end | |
((260) (k 'back)) | |
- ((32) | |
- (set! pos (if (> (+ pos rows) nlines) pos (+ pos (sub1 row… | |
- (when use-cursor | |
- (let adjust-cursor! () | |
- (cond ((> pos (current-cursor cursor)) | |
- (next-cursor! cursor) | |
- (adjust-cursor!)) | |
- ((< (+ pos (length dlines)) (current-cursor curs… | |
- (prev-cursor! cursor) | |
- (adjust-cursor!))))) | |
- pos) ; space | |
- ((10 261) (when use-cursor (k (list-ref lines (current-curs… | |
- ((263) (set! pos (if (< (- pos rows) 0) 0 (- pos (sub1 rows… | |
+ ((32) (let* ((np (if (> (+ newp rows) nlines) newp (+ newp … | |
+ (nsteps left (partition (lambda (x) (< x np)) … | |
+ (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-curs… | |
+ ((263) (let* ((np (if (< (- newp rows) 0) 0 (- newp (sub1 r… | |
+ (nsteps left (partition (lambda (x) (< x np))… | |
+ (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:… | |
- (else pos))))))))) | |
+ ((#x47 #x67) (k (uristring->entry (get-user-input "New uri:… | |
+ (else newp))))))))) | |
(define (get-user-input #!optional (prompt "Enter query:") (suggestion "")) | |
(let* ((l c (getmaxyx (stdscr))) |