summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2022-01-31 12:26:17 +0530
committerArun Isaac2022-01-31 12:26:17 +0530
commitba6cfeb0ba7066751504eca517f610331c0b4a2e (patch)
tree783b2f6c3c518a3ee971d863d4ab047e3bb60c70
parent8902f296e3851aeecd713a4ccae86b5abb3b0078 (diff)
downloadgn-gemtext-ba6cfeb0ba7066751504eca517f610331c0b4a2e.tar.gz
gnbug: Only read files checked in to the git repository.
* gnbug (issues): Use `git ls-files' to find files to read. (find-files): Delete function.
-rwxr-xr-xgnbug81
1 files changed, 33 insertions, 48 deletions
diff --git a/gnbug b/gnbug
index 0d36718..9913c9b 100755
--- a/gnbug
+++ b/gnbug
@@ -31,24 +31,6 @@ even if it exits non-locally. Return the value returned by PROC."
(zero? return-value))
(error "Invocation of program failed" (cons program args))))))))
-(define* (find-files directory #:optional (pred (const #t)))
- "Recursively find all files under DIRECTORY that satisfy PRED."
- (define (do-nothing name stat result)
- result)
-
- (file-system-fold (const #t)
- (lambda (name stat result)
- (if (pred name stat)
- (cons name result)
- result))
- do-nothing
- do-nothing
- do-nothing
- (lambda (name stat errno result)
- (error (strerror errno) name))
- '()
- directory))
-
(define-record-type <issue>
(issue file title creator created-date created-relative-date
last-updater last-updated-date last-updated-relative-date
@@ -74,36 +56,39 @@ even if it exits non-locally. Return the value returned by PROC."
;; 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 (map (lambda (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))))
- (find-files "."
- (lambda (name _)
- (and (string-suffix? ".gmi" name)
- (not (string=? (basename name) "README.gmi"))
- (not (string-prefix? "." (basename name)))))))
- (lambda (issue1 issue2)
- (< (issue-created-date issue1)
- (issue-created-date issue2)))))
+ (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