diff options
| -rw-r--r-- | README.gmi | 26 | ||||
| -rwxr-xr-x | gnbug | 546 |
2 files changed, 12 insertions, 560 deletions
@@ -33,40 +33,38 @@ Other discussions on leaving github => issues/README.gmi => https://github.com/bitcoin-core/bitcoin-devwiki/wiki/GitHub-alternatives-for-Bitcoin-Core -## gnbug +## tissue -You may peruse the issues in this repository using the provided gnbug command-line interface. gnbug requires guile. Please install guile before running gnbug. +You may peruse the issues in this repository using the tissue command-line interface. List all open issues. ``` -./gnbug list +tissue list ``` Only list open issues assigned to pjotrp. ``` -./gnbug list --assigned=pjotrp +tissue list --assigned=pjotrp ``` Print an issue, say issue 7, on the command line. ``` -./gnbug show 7 +tissue show 7 ``` Edit an issue, say issue 9. This opens the relevant gemtext file in your favourite editor as defined by the EDITOR environment variable. ``` -./gnbug edit 9 +tissue edit 9 ``` -List issues that were created or updated in the last 3 days, in the last week or month respectively. The --since argument is passed directly to `git log`. Therefore, gnbug understands any --since argument that `git log` understands. +List issues that were created or updated in the last 3 days, in the last week or month respectively. The --since argument is passed directly to `git log`. Therefore, tissue understands any --since argument that `git log` understands. ``` -./gnbug news --since='3 days' -./gnbug news --since='1 week' -./gnbug news --since='1 month' +tissue news --since='3 days' +tissue news --since='1 week' +tissue news --since='1 month' ``` -To learn more about gnbug, please use the built-in help feature. +To learn more about tissue, please use the built-in help feature. ``` -./gnbug --help +tissue --help ``` - -Using `direnv` with `gnbug` allows the user to drop the `./` in the command. @@ -1,546 +0,0 @@ -#! /usr/bin/env guile -!# - -(import (rnrs hashtables) - (rnrs io ports) - (srfi srfi-1) - (srfi srfi-9) - (srfi srfi-26) - (srfi srfi-37) - (srfi srfi-171) - (srfi srfi-171 gnu) - (ice-9 ftw) - (ice-9 match) - (ice-9 popen) - (ice-9 regex)) - -(define (invoke program . args) - (unless (zero? (apply system* program args)) - (error "Invocation of program failed" (cons program args)))) - -(define (call-with-input-pipe proc program . args) - "Execute PROGRAM ARGS ... in a subprocess with a pipe to it. Call -PROC with an input port to that pipe. Close the pipe once PROC exits, -even if it exits non-locally. Return the value returned by PROC." - (let ((port #f)) - (dynamic-wind (lambda () (set! port (apply open-pipe* OPEN_READ program args))) - (cut proc port) - (lambda () - (let ((return-value (status:exit-val (close-pipe port)))) - (unless (and return-value - (zero? return-value)) - (error "Invocation of program failed" (cons program args)))))))) - -(define-record-type <issue> - (issue file title creator created-date created-relative-date - last-updater last-updated-date last-updated-relative-date - assigned keywords open tasks completed-tasks posts) - issue? - (file issue-file) - (title issue-title) - (creator issue-creator) - (created-date issue-created-date) - (created-relative-date issue-created-relative-date) - (last-updater issue-last-updater) - (last-updated-date issue-last-updated-date) - (last-updated-relative-date issue-last-updated-relative-date) - (assigned issue-assigned) - (keywords issue-keywords) - (open issue-open) - (tasks issue-tasks) - (completed-tasks issue-completed-tasks) - (posts issue-posts)) - -(define (issues) - "Return a list of all issues, sorted oldest first." - ;; Get all gemini files except README.gmi and hidden files. Text - ;; editors tend to create hidden files while editing, and we want to - ;; avoid them. - (sort (call-with-input-pipe - (lambda (port) - (port-transduce - (tfilter-map (lambda (file) - (and (string-suffix? ".gmi" file) - (not (string=? (basename file) "README.gmi")) - (not (string-prefix? "." (basename file))) - (let* ((file-details (file-details file)) - (all-keywords (hashtable-ref file-details 'keywords '()))) - (issue file - ;; Fallback to filename if title has no alphabetic - ;; characters. - (let ((title (hashtable-ref file-details 'title ""))) - (if (string-any char-set:letter title) title file)) - (hashtable-ref file-details 'creator #f) - (hashtable-ref file-details 'created-date #f) - (hashtable-ref file-details 'created-relative-date #f) - (hashtable-ref file-details 'last-updater #f) - (hashtable-ref file-details 'last-updated-date #f) - (hashtable-ref file-details 'last-updated-relative-date #f) - (hashtable-ref file-details 'assigned '()) - ;; "closed" is a special keyword to indicate - ;; the open/closed status of an issue. - (delete "closed" all-keywords) - (not (member "closed" all-keywords)) - (hashtable-ref file-details 'tasks 0) - (hashtable-ref file-details 'completed-tasks 0) - (hashtable-ref file-details 'posts #f)))))) - rcons get-line port)) - "git" "ls-files") - (lambda (issue1 issue2) - (< (issue-created-date issue1) - (issue-created-date issue2))))) - -(define (hashtable-append! hashtable key new-values) - "Append NEW-VALUES to the list of values KEY is associated to in -HASHTABLE. If KEY is not associated to any value in HASHTABLE, assume -it is associated to the empty list." - (hashtable-update! - hashtable key (cut append <> new-values) '())) - -(define (comma-split str) - "Split string at commas, trim whitespace from both ends of the split -strings, and return them as a list." - (map (cut string-trim-both <>) - (string-split str #\,))) - -(define (remove-prefix prefix str) - "Remove PREFIX from STR." - (substring str (string-length prefix))) - -(define (get-line-dos-or-unix port) - "Read line from PORT. This differs from `get-line' in (rnrs io -ports) in that it also supports DOS line endings." - (let ((line (get-line port))) - (if (eof-object? line) - line - (string-trim-right line #\return)))) - -(define (file-details file) - "Return a hashtable of details extracted from gemini FILE." - (let ((result (make-eq-hashtable))) - (call-with-input-file file - (lambda (port) - (port-transduce (tmap (lambda (line) - (cond - ;; Lists with the assigned: prefix - ;; specify assignees. - ((string-prefix? "* assigned:" line) - (hashtable-append! result 'assigned - (comma-split - (remove-prefix "* assigned:" line)))) - ;; Lists with the keywords: prefix - ;; specify keywords. - ((string-prefix? "* keywords:" line) - (hashtable-append! result 'keywords - (comma-split - (remove-prefix "* keywords:" line)))) - ;; A more fuzzy heuristic to find keywords - ((and (string-prefix? "* " line) - ;; Is every comma-separated - ;; element two words utmost? - (every (lambda (element) - (<= (length - (string-split element #\space)) - 2)) - (comma-split (remove-prefix "* " line))) - ;; Does any comma-separated - ;; element contain a potential - ;; keyword? - (any (lambda (element) - (any (lambda (keyword) - (string-contains element keyword)) - (list "request" "bug" "critical" - "enhancement" "progress" - "testing" "later" "documentation" - "help" "closed"))) - (comma-split (remove-prefix "* " line)))) - (hashtable-append! result 'keywords - (comma-split - (remove-prefix "* " line)))) - ;; Checkbox lists are tasks. If the - ;; checkbox has any character other - ;; than space in it, the task is - ;; completed. - ((string-match "\\* \\[(.)\\]" line) - => (lambda (m) - (hashtable-update! result 'tasks 1+ 0) - (unless (string=? (match:substring m 1) " ") - (hashtable-update! result 'completed-tasks 1+ 0)))) - ;; The first level one heading is the - ;; title. - ((string-prefix? "# " line) - (unless (hashtable-contains? result 'title) - (hashtable-set! result 'title - (remove-prefix "# " line))))))) - (const #t) - get-line-dos-or-unix - port))) - (call-with-input-pipe - (lambda (port) - (hashtable-set! - result 'posts - (port-transduce - (compose (tenumerate) - (tmap (match-lambda - ((index . line) - (let ((alist (call-with-input-string line read))) - (when (zero? index) - (hashtable-set! result 'last-updater - (assq-ref alist 'author)) - (hashtable-set! result 'last-updated-date - (assq-ref alist 'author-date)) - (hashtable-set! result 'last-updated-relative-date - (assq-ref alist 'author-relative-date))) - (hashtable-set! result 'creator - (assq-ref alist 'author)) - (hashtable-set! result 'created-date - (assq-ref alist 'author-date)) - (hashtable-set! result 'created-relative-date - (assq-ref alist 'author-relative-date))))))) - rcount get-line port))) - "git" "log" - (string-append "--format=format:(" - "(author . \"%an\")" - "(author-date . %at)" - "(author-relative-date . \"%ar\")" - ")") - "--" file) - result)) - -(define (git-updated-files transducer start-commit end-commit) - "Use TRANSDUCER to transduce over the list of files updated between -START-COMMIT and END-COMMIT." - (call-with-input-pipe - (lambda (port) - (port-transduce (compose (tmap (lambda (line) - (match (string-split line #\tab) - ((status file) - (list (match status - ("A" 'added) - ("D" 'deleted) - ("M" 'modified)) - file))))) - transducer) - (const #t) get-line port)) - "git" "diff" "--stat" "--name-status" - (string-append start-commit ".." end-commit))) - -(define rlast - (case-lambda - (() #f) - ((result) result) - ((result input) input))) - -(define (git-first-commit-since since) - "Return the hash of the first git commit since SINCE, where SINCE is -passed verbatim to the --since argument of `git log'. Return #f if -there is no such commit." - (call-with-input-pipe - (lambda (port) - (port-transduce (tmap identity) - rlast - get-line - port)) - "git" "log" "--format=format:%H" "--since" since)) - -;;; -;;; 3 bit colors using ANSI escape codes -;;; - -(define (color code str) - "Return STR within ANSI escape CODE, thus rendering it in color in a -terminal." - (format #f "~a[~am~a~a[0m" #\esc code str #\esc)) - -(define bold (cut color 1 <>)) - -(define red (cut color 31 <>)) -(define green (cut color 32 <>)) -(define yellow (cut color 33 <>)) -(define blue (cut color 34 <>)) -(define magenta (cut color 35 <>)) -(define cyan (cut color 36 <>)) - -(define red-background (cut color 41 <>)) -(define green-background (cut color 42 <>)) -(define yellow-background (cut color 43 <>)) -(define blue-background (cut color 44 <>)) -(define magenta-background (cut color 45 <>)) -(define cyan-background (cut color 46 <>)) - -(define (invalid-option opt name arg loads) - (error "Invalid option" name)) - -(define (invalid-operand arg loads) - (error "Invalid argument" arg)) - -(define (command-line-program) - "Return the name, that is arg0, of the command-line program invoked -to run gnbug." - (match (command-line) - ((program _ ...) program))) - -(define gnbug-news - (match-lambda* - (("--help") - (format #t "Usage: ~a news -List recent updates. - - --since=DATE show updates more recent than DATE - -" - (command-line-program))) - (args - (let ((args (args-fold args - (list (option (list "since") #t #f - (lambda (opt name arg loads) - (acons 'since arg loads)))) - invalid-option - invalid-operand - '()))) - (unless (assq 'since args) - (error "--since argument required")) - (git-updated-files (tlog (match-lambda* - ((_ (status file)) - (format #t ((case status - ((added) green) - ((deleted) red) - ((modified) magenta)) - "~a (~a)~%") - file - (case status - ((added) "new") - ((deleted) "deleted") - ((modified) "updated")))))) - (or (git-first-commit-since (assq-ref args 'since)) - "HEAD") - "HEAD"))))) - -(define (print-issue issue-number issue) - "Print ISSUE with number ISSUE-NUMBER." - (display (magenta (issue-title issue))) - ;; Highlight keywords containing "bug" or "critical" as whole words - ;; in red. Else, highlight in blue. - (unless (null? (issue-keywords issue)) - (display " ") - (display (string-join - (map (lambda (keyword) - ((cond - ((not (null? (lset-intersection - string=? - (string-split keyword #\space) - (list "bug" "critical")))) - red-background) - (else blue-background)) - (string-append " " keyword " "))) - (issue-keywords issue)) - " "))) - (unless (null? (issue-assigned issue)) - (display (green (string-append " (assigned: " - (string-join (issue-assigned issue) - ", ") - ")")))) - (when (> (issue-posts issue) 1) - (display (string-append " [" - (number->string (issue-posts issue)) - " posts]"))) - (newline) - (display (string-append - (cyan (string-append "#" (number->string issue-number))) - " opened " - (cyan (issue-created-relative-date issue)) - " by " - (cyan (issue-creator issue)))) - (when (> (issue-posts issue) 1) - (display (string-append (cyan ",") - " last updated " - (cyan (issue-last-updated-relative-date issue)) - " by " - (cyan (issue-last-updater issue))))) - (unless (zero? (issue-tasks issue)) - (display (string-append (cyan "; ") - (number->string (issue-completed-tasks issue)) - "/" - (number->string (issue-tasks issue)) - " tasks done"))) - (newline)) - -(define (print-issue-to-gemtext issue-number issue) - "Print ISSUE with number ISSUE-NUMBER to gemtext." - (format #t "=> ~a ~a" (issue-file issue) (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 (> (issue-posts issue) 1) - (format #t " [~a posts]" (issue-posts issue))) - (newline) - (format #t "~a opened ~a by ~a" - issue-number - (issue-created-relative-date issue) - (issue-creator issue)) - (when (> (issue-posts issue) 1) - (format #t ", last updated ~a by ~a" - (issue-last-updated-relative-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 gnbug-list - (match-lambda* - (("--help") - (format #t "Usage: ~a list [OPTIONS] -List issues. - - --assigned=ASSIGNED only list issues assigned to ASSIGNED - --format=FORMAT output in FORMAT (either text or gemtext, and text by default) - -" - (command-line-program))) - (args - (let ((args (args-fold args - (list (option (list "assigned") #t #f - (lambda (opt name arg loads) - (acons 'assigned arg loads))) - (option (list "format") #t #f - (lambda (opt name arg loads) - (acons 'format - (cond - ((string=? arg "text") 'text) - ((string=? arg "gemtext") 'gemtext) - (else (error "Unknown format" arg))) - loads)))) - invalid-option - invalid-operand - '((format . text))))) - (format #t "~%total ~a~%" - (list-transduce (compose (tenumerate 1) - (tfilter (match-lambda - ((_ . issue) - (and (issue-open issue) - (or (not (assq 'assigned args)) - (member (assq-ref args 'assigned) - (issue-assigned issue))))))) - (tlog (match-lambda* - ((_ (index . issue)) - ((case (assq-ref args 'format) - ((text) print-issue) - ((gemtext) print-issue-to-gemtext)) - index issue))))) - rcount - (issues))))))) - -(define gnbug-edit - (match-lambda* - (("--help") - (format #t "Usage: ~a edit ISSUE-NUMBER -Start $EDITOR to edit issue #ISSUE-NUMBER. - -" - (command-line-program))) - ((issue-number) - (unless (getenv "EDITOR") - (error "Please set the EDITOR environment variable to your favorite editor. For example, -export EDITOR=emacsclient")) - (invoke (getenv "EDITOR") - (issue-file (list-ref (issues) - (1- (string->number issue-number)))))))) - -(define gnbug-show - (match-lambda* - (("--help") - (format #t "Usage: ~a show ISSUE-NUMBER -Show the text of issue #ISSUE-NUMBER. - -" - (command-line-program))) - ((issue-number) - (call-with-input-file (issue-file (list-ref (issues) - (1- (string->number issue-number)))) - (lambda (port) - (port-transduce - (compose - ;; Detect preformatted text blocks. - (tfold (match-lambda* - (((pre? . _) line) - (cons (if (string-prefix? "```" line) - (not pre?) - pre?) - line))) - (cons #f #f)) - (tmap (lambda (pre?+line) - (match pre?+line - ((pre? . line) - (cond - ;; Print headlines in bold. - ((string-prefix? "#" line) - (display (bold line))) - ;; Print lists in cyan. - ((string-prefix? "*" line) - (display (cyan line))) - ;; Print links in cyan, but only the actual - ;; link, and not the => prefix or the label. - ((string-match "^(=>[ \t]*)([^ ]*)([^\n]*)" line) - => (lambda (m) - (display (match:substring m 1)) - (display (cyan (match:substring m 2))) - (display (match:substring m 3)))) - ;; Print preformatted text backticks in - ;; magenta. - ((string-prefix? "```" line) - (display (magenta line))) - (else - ;; If part of preformatted block, print in - ;; magenta. Else, print in default color. - (display (if pre? (magenta line) line)))))) - (newline)))) - (const #t) - get-line-dos-or-unix - port)))))) - -(define (print-usage) - (format #t "Usage: ~a COMMAND [OPTIONS] [ARGS] - -COMMAND must be one of the sub-commands listed below: - - list list issues - edit edit an issue - show show the text of an issue - news list recent updates - -To get usage information for one of these sub-commands, run - ~a COMMAND --help - -" - (command-line-program) - (command-line-program))) - -(define main - (match-lambda* - ((_ (or "-h" "--help")) - (print-usage)) - ((_ command args ...) - (apply (match command - ("news" gnbug-news) - ("list" gnbug-list) - ("edit" gnbug-edit) - ("show" gnbug-show) - (invalid-command - (format (current-error-port) "Invalid command `~a'~%~%" - invalid-command) - (print-usage) - (exit #f))) - args)) - ;; gnbug is an alias for `gnbug list' - ((_) - (gnbug-list)))) - -(apply main (command-line)) |