diff options
| -rwxr-xr-x | bin/tissue | 3 | ||||
| -rw-r--r-- | tissue/issue.scm | 59 | ||||
| -rw-r--r-- | tissue/tissue.scm | 27 |
3 files changed, 55 insertions, 34 deletions
diff --git a/bin/tissue b/bin/tissue index c341310..555f114 100755 --- a/bin/tissue +++ b/bin/tissue @@ -403,7 +403,8 @@ To get usage information for one of these sub-commands, run (current-error-port)) (newline (current-error-port)) (exit #f))) - (parameterize ((%aliases (tissue-configuration-aliases (load-config)))) + (parameterize ((%issue-files (tissue-configuration-issue-files (load-config))) + (%aliases (tissue-configuration-aliases (load-config)))) (apply (match command ("news" tissue-news) ("list" tissue-list) diff --git a/tissue/issue.scm b/tissue/issue.scm index f7dcef9..72d3d9c 100644 --- a/tissue/issue.scm +++ b/tissue/issue.scm @@ -29,7 +29,8 @@ #:use-module (ice-9 regex) #:use-module (tissue git) #:use-module (tissue utils) - #:export (%aliases + #:export (%issue-files + %aliases issue issue-file issue-title @@ -52,6 +53,9 @@ authors issues)) +(define %issue-files + (make-parameter #f)) + (define %aliases (make-parameter #f)) @@ -268,34 +272,31 @@ in (tissue tissue). If no alias is found, NAME is returned as such." ;; editors tend to create hidden files while editing, and we want to ;; avoid them. (sort (filter-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)) - ;; Downcase keywords to make them - ;; case-insensitive. - (all-keywords (map string-downcase - (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))))) - (git-tracked-files)) + (let* ((file-details (file-details file)) + ;; Downcase keywords to make them + ;; case-insensitive. + (all-keywords (map string-downcase + (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)))) + (%issue-files)) (lambda (issue1 issue2) (time<? (date->time-monotonic (issue-created-date issue1)) (date->time-monotonic (issue-created-date issue2)))))))) diff --git a/tissue/tissue.scm b/tissue/tissue.scm index 4af4886..194587d 100644 --- a/tissue/tissue.scm +++ b/tissue/tissue.scm @@ -20,19 +20,23 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-71) + #:use-module (tissue git) #:export (tissue-configuration tissue-configuration? tissue-configuration-project tissue-configuration-aliases + tissue-configuration-issue-files tissue-configuration-web-css tissue-configuration-web-tags-path - tissue-configuration-web-files)) + tissue-configuration-web-files + gemtext-files-in-directory)) (define-record-type <tissue-configuration> - (make-tissue-configuration project aliases web-css web-tags-path web-files) + (make-tissue-configuration project aliases issue-files web-css web-tags-path web-files) tissue-configuration? (project tissue-configuration-project) (aliases tissue-configuration-aliases) + (issue-files tissue-configuration-issue-files) (web-css tissue-configuration-web-css) (web-tags-path tissue-configuration-web-tags-path) (web-files delayed-tissue-configuration-web-files)) @@ -40,6 +44,17 @@ (define tissue-configuration-web-files (compose force delayed-tissue-configuration-web-files)) +(define* (gemtext-files-in-directory #:optional directory) + "Return a list of all gemtext files in DIRECTORY tracked in the +current git repository. If DIRECTORY is #f, return the list of all +gemtext files tracked in the current git repository regardless of +which directory they are in." + (filter (lambda (filename) + (and (or (not directory) + (string-prefix? directory filename)) + (string-suffix? ".gmi" filename))) + (git-tracked-files))) + (define-syntax tissue-configuration (lambda (x) (syntax-case x () @@ -48,7 +63,9 @@ (eq? (syntax->datum arg) #:web-files)) #'(args ...)))) - #`(apply (lambda* (#:key project (aliases '()) web-css (web-tags-path "/tags") (web-files '())) + #`(apply (lambda* (#:key project (aliases '()) + (issue-files (gemtext-files-in-directory)) + web-css (web-tags-path "/tags") (web-files '())) "PROJECT is the name of the project. It is used in the title of the generated web pages, among other places. @@ -56,6 +73,8 @@ ALIASES is a list of aliases used to refer to authors in the repository. Each element is in turn a list of aliases an author goes by, the first of which is the canonical name of that author. +ISSUE-FILES is a list of files that pertain to issues. + WEB-CSS is the path to a CSS stylesheet. It is relative to the document root and must begin with a /. If it is #f, no stylesheet is used in the generated web pages. @@ -65,7 +84,7 @@ per-tag issue listings are put. It must begin with a /. WEB-FILES is a list of <file> objects representing files to be written to the web output." - (make-tissue-configuration project aliases web-css web-tags-path web-files)) + (make-tissue-configuration project aliases issue-files web-css web-tags-path web-files)) (list #,@(append before (syntax-case after () ((web-files-key web-files rest ...) |