diff options
| -rwxr-xr-x | bin/tissue | 94 | ||||
| -rw-r--r-- | tissue/issue.scm | 76 | ||||
| -rw-r--r-- | tissue/utils.scm | 22 |
3 files changed, 98 insertions, 94 deletions
diff --git a/bin/tissue b/bin/tissue index 94ab5d6..1453112 100755 --- a/bin/tissue +++ b/bin/tissue @@ -24,7 +24,6 @@ exec guile --no-auto-compile -s "$0" "$@" (rnrs io ports) (srfi srfi-1) (srfi srfi-9) - (srfi srfi-19) (srfi srfi-26) (srfi srfi-37) (srfi srfi-171) @@ -61,26 +60,6 @@ exec guile --no-auto-compile -s "$0" "$@" ;; A string URI linking to this document on the web (web-uri indexed-document-web-uri)) -(define (human-date-string date) - "Return a human readable rendering of DATE." - (let ((elapsed-time - (time-second - (time-difference (date->time-monotonic (current-date)) - (date->time-monotonic date))))) - (cond - ((< elapsed-time (* 2 60)) - (format #f "~a seconds ago" elapsed-time)) - ((< elapsed-time (* 2 60 60)) - (format #f "~a minutes ago" (round (/ elapsed-time 60)))) - ((< elapsed-time (* 2 24 60 60)) - (format #f "~a hours ago" (round (/ elapsed-time 60 60)))) - ((< elapsed-time (* 2 7 24 60 60)) - (format #f "~a days ago" (round (/ elapsed-time 60 60 24)))) - ((< elapsed-time (* 2 30 24 60 60)) - (format #f "~a weeks ago" (round (/ elapsed-time 60 60 24 7)))) - (else - (format #f "on ~a" (date->string date "~b ~d ~Y")))))) - (define (invalid-option opt name arg loads) (error "Invalid option" name)) @@ -93,79 +72,6 @@ to run tissue." (match (command-line) ((program _ ...) program))) -(define (print-issue issue) - "Print ISSUE." - (let ((number-of-posts (length (issue-posts issue)))) - (display (colorize-string (issue-title issue) 'MAGENTA 'UNDERLINE)) - (unless (null? (issue-keywords issue)) - (display " ") - (display (string-join (map (cut colorize-string <> 'ON-BLUE) - (issue-keywords issue)) - " "))) - (unless (null? (issue-assigned issue)) - (display (colorize-string (string-append " (assigned: " - (string-join (issue-assigned issue) - ", ") - ")") - 'GREEN))) - (when (> number-of-posts 1) - (display (string-append " [" - (number->string number-of-posts) - " posts]"))) - (newline) - (display (colorize-string (issue-file issue) 'YELLOW)) - (newline) - (display (string-append - "opened " - (colorize-string (human-date-string (issue-created-date issue)) 'CYAN) - " by " - (colorize-string (issue-creator issue) 'CYAN))) - (when (> number-of-posts 1) - (display (string-append (colorize-string "," 'CYAN) - " last updated " - (colorize-string (human-date-string (issue-last-updated-date issue)) - 'CYAN) - " by " - (colorize-string (issue-last-updater issue) - 'CYAN)))) - (unless (zero? (issue-tasks issue)) - (display (string-append (colorize-string "; " 'CYAN) - (number->string (issue-completed-tasks issue)) - "/" - (number->string (issue-tasks issue)) - " tasks done"))) - (newline) - (newline))) - -(define (print-issue-to-gemtext issue) - "Print ISSUE to gemtext." - (let ((number-of-posts (length (issue-posts issue)))) - (format #t "# ~a" (issue-title issue)) - (unless (null? (issue-keywords issue)) - (format #t " [~a]" - (string-join (issue-keywords issue) - ", "))) - (unless (null? (issue-assigned issue)) - (format #t " (assigned: ~a)" - (string-join (issue-assigned issue) - ", "))) - (when (> number-of-posts 1) - (format #t " [~a posts]" number-of-posts)) - (newline) - (format #t "opened ~a by ~a" - (human-date-string (issue-created-date issue)) - (issue-creator issue)) - (when (> number-of-posts 1) - (format #t ", last updated ~a by ~a" - (human-date-string (issue-last-updated-date issue)) - (issue-last-updater issue))) - (unless (zero? (issue-tasks issue)) - (format #t "; ~a/~a tasks done" - (issue-completed-tasks issue) - (issue-tasks issue))) - (newline) - (newline))) - (define (print-document document) "Print DOCUMENT, an <issue> or <document> object." ((cond diff --git a/tissue/issue.scm b/tissue/issue.scm index cbf4551..4dd1854 100644 --- a/tissue/issue.scm +++ b/tissue/issue.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-171) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (term ansi-color) #:use-module (git) #:use-module (xapian xapian) #:use-module (tissue git) @@ -54,6 +55,8 @@ alist->issue post->alist alist->post + print-issue + print-issue-to-gemtext issues read-gemtext-issue index-issue)) @@ -137,6 +140,79 @@ serialized." (post (assq-ref alist 'author) (iso-8601->date (assq-ref alist 'date)))) +(define (print-issue issue) + "Print ISSUE, an <issue> object, in search results." + (let ((number-of-posts (length (issue-posts issue)))) + (display (colorize-string (issue-title issue) 'MAGENTA 'UNDERLINE)) + (unless (null? (issue-keywords issue)) + (display " ") + (display (string-join (map (cut colorize-string <> 'ON-BLUE) + (issue-keywords issue)) + " "))) + (unless (null? (issue-assigned issue)) + (display (colorize-string (string-append " (assigned: " + (string-join (issue-assigned issue) + ", ") + ")") + 'GREEN))) + (when (> number-of-posts 1) + (display (string-append " [" + (number->string number-of-posts) + " posts]"))) + (newline) + (display (colorize-string (issue-file issue) 'YELLOW)) + (newline) + (display (string-append + "opened " + (colorize-string (human-date-string (issue-created-date issue)) 'CYAN) + " by " + (colorize-string (issue-creator issue) 'CYAN))) + (when (> number-of-posts 1) + (display (string-append (colorize-string "," 'CYAN) + " last updated " + (colorize-string (human-date-string (issue-last-updated-date issue)) + 'CYAN) + " by " + (colorize-string (issue-last-updater issue) + 'CYAN)))) + (unless (zero? (issue-tasks issue)) + (display (string-append (colorize-string "; " 'CYAN) + (number->string (issue-completed-tasks issue)) + "/" + (number->string (issue-tasks issue)) + " tasks done"))) + (newline) + (newline))) + +(define (print-issue-to-gemtext issue) + "Print ISSUE to gemtext." + (let ((number-of-posts (length (issue-posts issue)))) + (format #t "# ~a" (issue-title issue)) + (unless (null? (issue-keywords issue)) + (format #t " [~a]" + (string-join (issue-keywords issue) + ", "))) + (unless (null? (issue-assigned issue)) + (format #t " (assigned: ~a)" + (string-join (issue-assigned issue) + ", "))) + (when (> number-of-posts 1) + (format #t " [~a posts]" number-of-posts)) + (newline) + (format #t "opened ~a by ~a" + (human-date-string (issue-created-date issue)) + (issue-creator issue)) + (when (> number-of-posts 1) + (format #t ", last updated ~a by ~a" + (human-date-string (issue-last-updated-date issue)) + (issue-last-updater issue))) + (unless (zero? (issue-tasks issue)) + (format #t "; ~a/~a tasks done" + (issue-completed-tasks issue) + (issue-tasks issue))) + (newline) + (newline))) + (define (hashtable-append! hashtable key new-values) "Append NEW-VALUES to the list of values KEY is associated to in HASHTABLE. Deduplicate the resulting list if necessary. If KEY is not diff --git a/tissue/utils.scm b/tissue/utils.scm index c3b3e3a..aed729b 100644 --- a/tissue/utils.scm +++ b/tissue/utils.scm @@ -18,9 +18,11 @@ (define-module (tissue utils) #:use-module (rnrs io ports) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (ice-9 popen) #:export (string-remove-prefix + human-date-string call-with-current-directory get-line-dos-or-unix memoize-thunk)) @@ -29,6 +31,26 @@ "Remove PREFIX from STR." (substring str (string-length prefix))) +(define (human-date-string date) + "Return a human readable rendering of DATE." + (let ((elapsed-time + (time-second + (time-difference (date->time-monotonic (current-date)) + (date->time-monotonic date))))) + (cond + ((< elapsed-time (* 2 60)) + (format #f "~a seconds ago" elapsed-time)) + ((< elapsed-time (* 2 60 60)) + (format #f "~a minutes ago" (round (/ elapsed-time 60)))) + ((< elapsed-time (* 2 24 60 60)) + (format #f "~a hours ago" (round (/ elapsed-time 60 60)))) + ((< elapsed-time (* 2 7 24 60 60)) + (format #f "~a days ago" (round (/ elapsed-time 60 60 24)))) + ((< elapsed-time (* 2 30 24 60 60)) + (format #f "~a weeks ago" (round (/ elapsed-time 60 60 24 7)))) + (else + (format #f "on ~a" (date->string date "~b ~d ~Y")))))) + (define (call-with-current-directory curdir thunk) "Call THUNK with current directory set to CURDIR. Restore current directory after THUNK returns." |