diff options
| -rwxr-xr-x | bin/tissue | 19 | ||||
| -rw-r--r-- | tissue/issue.scm | 85 |
2 files changed, 47 insertions, 57 deletions
@@ -93,14 +93,6 @@ to run tissue." (match (command-line) ((program _ ...) program))) -(define (print-document document) - "Print DOCUMENT, an <issue> or <document> object." - ((cond - ((issue? document) print-issue) - ((doc:document? document) doc:print-document) - (else (raise (unknown-document-type-violation document)))) - document)) - (define (print-issue issue) "Print ISSUE." (let ((number-of-posts (length (issue-posts issue)))) @@ -174,6 +166,14 @@ to run tissue." (newline) (newline))) +(define (print-document document) + "Print DOCUMENT, an <issue> or <document> object." + ((cond + ((issue? document) print-issue) + ((doc:document? document) doc:print-document) + (else (raise (unknown-document-type-violation document)))) + document)) + (define (alist->document alist) "Convert ALIST to an <issue> or <document> object." ((case (assq-ref alist 'type) @@ -396,8 +396,7 @@ DB." (exit #f))) (call-with-current-directory (git-top-level) (lambda () - (parameterize ((%issue-files (tissue-configuration-issue-files (load-config))) - (%aliases (tissue-configuration-aliases (load-config)))) + (parameterize ((%aliases (tissue-configuration-aliases (load-config)))) ;; Create hidden tissue directory unless it exists. (unless (file-exists? %state-directory) (mkdir %state-directory)) diff --git a/tissue/issue.scm b/tissue/issue.scm index c68be9a..cbf4551 100644 --- a/tissue/issue.scm +++ b/tissue/issue.scm @@ -31,8 +31,7 @@ #:use-module (xapian xapian) #:use-module (tissue git) #:use-module (tissue utils) - #:export (%issue-files - %aliases + #:export (%aliases issue issue? issue-file @@ -56,11 +55,9 @@ post->alist alist->post issues + read-gemtext-issue index-issue)) -(define %issue-files - (make-parameter #f)) - (define %aliases (make-parameter #f)) @@ -276,49 +273,43 @@ in (tissue tissue). If no alias is found, NAME is returned as such." port)))) result)) -(define issues +(define file-modification-table-for-current-repository (memoize-thunk - (lambda () - "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. - (let ((file-modification-table (file-modification-table (current-git-repository)))) - (sort (filter-map (lambda (file) - (let* ((file-details (file-details file)) - ;; Downcase keywords to make them - ;; case-insensitive. - (all-keywords (map string-downcase - (hashtable-ref file-details 'keywords '()))) - (commits (hashtable-ref file-modification-table file #f)) - (commit-authors (map (lambda (commit) - (resolve-alias (signature-name (commit-author commit)) - (%aliases))) - commits))) - (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)) - (first commit-authors) - (commit-date (first commits)) - (last commit-authors) - (commit-date (last commits)) - (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) - (map (lambda (commit author) - (post author (commit-date commit))) - commits - commit-authors)))) - (%issue-files)) - (lambda (issue1 issue2) - (time<? (date->time-monotonic (issue-created-date issue1)) - (date->time-monotonic (issue-created-date issue2))))))))) + (cut file-modification-table (current-git-repository)))) + +(define (read-gemtext-issue file) + "Read issue from gemtext FILE. Return an <issue> object." + (let* ((file-details (file-details file)) + ;; Downcase keywords to make them + ;; case-insensitive. + (all-keywords (map string-downcase + (hashtable-ref file-details 'keywords '()))) + (commits (hashtable-ref (file-modification-table-for-current-repository) + file #f)) + (commit-authors (map (lambda (commit) + (resolve-alias (signature-name (commit-author commit)) + (%aliases))) + commits))) + (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)) + (first commit-authors) + (commit-date (first commits)) + (last commit-authors) + (commit-date (last commits)) + (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) + (map (lambda (commit author) + (post author (commit-date commit))) + commits + commit-authors)))) (define (index-person term-generator name prefix) "Index all aliases of person of canonical NAME using TERM-GENERATOR |