summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.gmi26
-rwxr-xr-xgnbug546
2 files changed, 12 insertions, 560 deletions
diff --git a/README.gmi b/README.gmi
index b8a3e02..949da34 100644
--- a/README.gmi
+++ b/README.gmi
@@ -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.
diff --git a/gnbug b/gnbug
deleted file mode 100755
index 5e58db0..0000000
--- a/gnbug
+++ /dev/null
@@ -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))