From 5b9902a09c06ae1ebbd734b8322ee4c3d5d64742 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Jul 2020 20:02:00 +0200 Subject: Term output work. --- module/output/terminal.scm | 175 ++++++++++++++++++++++++++++----------------- 1 file changed, 109 insertions(+), 66 deletions(-) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 28d631ee..b6ea40f7 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -2,6 +2,7 @@ #:use-module (output general) #:use-module (srfi srfi-1) #:use-module (datetime) + #:use-module (srfi srfi-17) #:use-module (srfi srfi-26) #:use-module (srfi srfi-41) #:use-module (srfi srfi-41 util) @@ -42,20 +43,23 @@ "" (map (cut make-string <> line) lengths))) (define* (display-event-table events #:key - (cur-event -1) - (summary-width 30) + (active-element -1) + ;; (summary-width 30) + (date-width 17) (location-width 20)) + (define summary-width (- width date-width location-width 6)) + + (displayln + (box-top #\┬ #\─ date-width (+ summary-width 2) (1+ location-width))) (for-each (lambda (ev i) (display (string-append (if (datetime? (prop ev 'DTSTART)) - (datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M:~S") - ((@ (texinfo string-utils) center-string) - (date->string (prop ev 'DTSTART)) - 19)) + (datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M") + (date->string (prop ev 'DTSTART) "~Y-~m-~d --:--")) " │ " - (if (= i cur-event) "\x1b[7m" "") + (if (= i active-element) "\x1b[7m" "") (color-escape (prop (parent ev) 'COLOR)) ;; Summary filter is a hook for the user (let ((dirty (prop ev '-X-HNH-DIRTY))) @@ -72,19 +76,28 @@ STR-RESET "\n"))) events - (iota (length events)))) + (iota (length events))) + (displayln + (box-top #\┴ #\─ date-width (+ summary-width 2) (1+ location-width)))) (define (displayln a) (display a) (newline)) -(define-class () - (event-set getter: get-event-set - init-keyword: event-set:) +(define-class () + (event-set getter: get-event-set init-keyword: event-set:) + (active-element accessor: active-element + init-value: 0) + (current-page accessor: current-page + init-keyword: current-page:) + + ) + + +(define-class () + #; (date accessor: view-date init-keyword: date:) - (cur-event accessor: cur-event - init-value: 0) (cached-events accessor: cached-events init-value: #f) @@ -103,32 +116,24 @@ (set/r! (cached-events this) (group->event-list (stream-car (get-groups-between (groups this) - (view-date this) - (view-date this))))))) + (current-page this) + (current-page this))))))) (cls) (display "== Day View ==\n") - (display-calendar-header! (view-date this)) + (display-calendar-header! (current-page this)) ;; display event list - (let* ((date-width 20) - (location-width 15) - (summary-width (- width date-width location-width 6))) - (displayln - (box-top #\┬ #\─ date-width (+ summary-width 2) (1+ location-width))) - (display-event-table - events - #:cur-event (cur-event this) - #:location-width location-width - #:summary-width summary-width) - (displayln - (box-top #\┴ #\─ date-width (+ summary-width 2) (1+ location-width)))) + (display-event-table + events + active-element: (active-element this) + location-width: 15) ;; display highlighted event (unless (null? events) - (let ((ev (list-ref events (cur-event this)))) + (let ((ev (list-ref events (active-element this)))) (format #t "~a~%~% ~a~%~%~a\x1b[1mStart:\x1b[m ~a \x1b[1mSlut:\x1b[m ~a~%~%~a~%" (prop ev '-X-HNH-FILENAME) (prop ev 'SUMMARY) @@ -154,24 +159,24 @@ (case char ((#\L #\l) - (set! (view-date this) = add-day + (set! (current-page this) = add-day (cached-events this) #f - (cur-event this) 0)) + (active-element this) 0)) ((#\h #\H) - (set! (view-date this) = remove-day + (set! (current-page this) = remove-day (cached-events this) #f - (cur-event this) 0)) + (active-element this) 0)) ((#\t) ;; TODO this should be local time ;; currently it's UTC (maybe?) - (set! (view-date this) (current-date) - (cur-event this) 0)) - ((#\j #\J) (unless (= (cur-event this) (1- (length events))) - (set! (cur-event this) = (+ 1)))) - ((#\k #\K) (unless (= (cur-event this) 0) - (set! (cur-event this) = (- 1)))) - ((#\g) (set! (cur-event this) 0)) - ((#\G) (set! (cur-event this) (1- (length events)))) + (set! (current-page this) (current-date) + (active-element this) 0)) + ((#\j #\J) (unless (= (active-element this) (1- (length events))) + (set! (active-element this) = (+ 1)))) + ((#\k #\K) (unless (= (active-element this) 0) + (set! (active-element this) = (- 1)))) + ((#\g) (set! (active-element this) 0)) + ((#\G) (set! (active-element this) (1- (length events)))) ((#\q) '(pop)) ((#\() (set-cursor-pos 0 (1- height)) (let* ((attr (make-termios)) @@ -186,39 +191,41 @@ )))) (define (day-view event-set date) - (make event-set: event-set date: date)) + (make event-set: event-set current-page: date)) -(define-class () - (event-set getter: get-event-set init-keyword: event-set:) +(define-class () (search-result getter: search-result) - (search-term getter: search-term - init-keyword: search-term:)) + (search-term accessor: search-term + init-keyword: search-term:) + (max-page accessor: max-page + init-form: (cons #f 0)) + ) (define (search-view search-term event-set) (make search-term: search-term event-set: event-set)) (define (prepare-string str) - (define missing-parenthesis-count - (string-fold (lambda (char count) - (case char - ((#\() (1+ count)) - ((#\)) (1- count)) - (else count))) - 0 str)) + (string-fold (lambda (char count) + (case char + ((#\() (1+ count)) + ((#\)) (1- count)) + (else count))) + 0 str)) (string-append str (make-string missing-parenthesis-count #\)))) (define-method (initialize (this ) args) + (set! (current-page this) 0) (next-method) ;; (display (search-term this)) (newline) (slot-set! this 'search-result (stream-paginate (stream-filter - (eval (print-and-return - `(lambda (event) ,(call-with-input-string - (prepare-string (search-term this)) - read))) + (eval `(lambda (event) ,(set/r! (search-term this) + (call-with-input-string + (prepare-string (search-term this)) + read))) (make-sandbox-module `( ((vcomponent base) prop) @@ -239,13 +246,17 @@ (lambda () (call-with-time-limit 1 - (lambda () (stream->list (stream-ref (search-result this) 0))) + (lambda () (stream->list (stream-ref (search-result this) (current-page this)))) (lambda _ (throw 'timed-out)))) (lambda (err . args) (display (cons err args) (current-error-port)) (newline (current-error-port)) + (case err + ((timed-out) (set! (max-page this) (cons #t (1- (current-page this))) + (current-page this) (cdr (max-page this))))) 'timed-out ; when search took to long 'unbound-variable ; when search term has unbound variables + 'wrong-type-arg ;; stream-ref '() ) @@ -254,17 +265,49 @@ (cls) (display "== Search View ==\n") - (for entry in page - (let ((start (prop entry 'DTSTART))) - (display - (if (date? start) - (date->string start "~Y-~m-~d ") - (datetime->string start "~Y-~m-~d ~H:~M ")))) - (display (prop entry 'SUMMARY)) - (newline))) + + ;; display search term + (format #t "~y" (search-term this)) + + ;; display event list + (display-event-table + page + #:active-element (active-element this) + #:location-width 15) + + ;; display page counter + (let ((start (max 0 (- (current-page this) 5))) + (end (min (+ (current-page this) 5) (cdr (max-page this))))) + + (display + (if (= start 0) + "|" "<")) + + (for-each (lambda (i) + (if (= i (current-page this)) + (format #t "[~2@a]" i) + (format #t " ~2@a " i))) + (iota (1+ (- end start)) start)) + + + (display + (if (= end (cdr (max-page this))) + (if (car (max-page this)) + "|" "?") + ">")) + (newline))) (define-method (input (this ) char) (case char + ((#\h) (set! (current-page this) = ((lambda (old) (max 0 (1- old)))))) + ((#\l) (set! (current-page this) = ((lambda (old) + ;; true final page + (if (car (max-page this)) + (min (1+ old) (cdr (max-page this))) + (begin + (set! (cdr (max-page this)) + (max (1+ old) (cdr (max-page this)))) + (1+ old))))))) ((#\q) '(pop)))) (app/define-method (main-loop date) -- cgit v1.2.3