arunisaac
/
tissue
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

tissue: Add #:issue-files configuration parameter. 

* tissue/tissue.scm: Import (tissue git).
(<tissue-configuration>)[issue-files]: New field.
(gemtext-files-in-directory): New function.
(tissue-configuration): Add #:issue-files keyword argument.
* tissue/issue.scm (%issue-files): New public parameter.
(issues): Read issues only from files in %issue-files.
* bin/tissue (main): Parameterize %issue-files.
main
Arun Isaac 2 months ago
parent
19bd6994ab
commit
85811ab5e6
Signed by: arunisaac GPG Key ID: 2E25EE8B61802BB3
3 changed files with 55 additions and 34 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 3
      bin/tissue
  2. 59
      tissue/issue.scm
  3. 27
      tissue/tissue.scm

3
bin/tissue
View File

@ -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)

59
tissue/issue.scm
View File

@ -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))))))))

27
tissue/tissue.scm
View File

@ -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 ...)

Write Preview
Loading…
Cancel
Save