diff options
author | Arun Isaac | 2022-07-03 01:44:50 +0530 |
---|---|---|
committer | Arun Isaac | 2022-07-03 23:21:41 +0530 |
commit | 2562403d13daaabb1c6eb324b2c34b0c17e1656b (patch) | |
tree | c22f4ee45909f416f90d62ee3b3ab7501bb19d00 /tissue/issue.scm | |
parent | 7db5c16efe41ed0e57be24125f21edf94e78429e (diff) | |
download | tissue-2562403d13daaabb1c6eb324b2c34b0c17e1656b.tar.gz tissue-2562403d13daaabb1c6eb324b2c34b0c17e1656b.tar.lz tissue-2562403d13daaabb1c6eb324b2c34b0c17e1656b.zip |
tissue: Read files from git repository, not from the working tree.
This also frees us from checking if the file actually exists in the
working tree.
* bin/tissue (tissue-show): Use call-with-file-in-git instead of
call-with-input-file.
(load-config): Use call-with-file-in-git and eval-string instead of
load.
* tissue/document.scm: Import (tissue git).
(document-text, read-gemtext-document): Use call-with-file-in-git
instead of call-with-input-file.
* tissue/issue.scm (file-details): Read from a port instead of from a
file.
(read-gemtext-issue): Call file-details with a port reading the file
committed into the git repository.
* tissue/web/server.scm: Import (tissue git).
* tissue/web/static.scm (exporter): Use call-with-file-in-git instead
of call-with-input-file.
Diffstat (limited to 'tissue/issue.scm')
-rw-r--r-- | tissue/issue.scm | 137 |
1 files changed, 67 insertions, 70 deletions
diff --git a/tissue/issue.scm b/tissue/issue.scm index f6e51ff..02982e1 100644 --- a/tissue/issue.scm +++ b/tissue/issue.scm @@ -312,76 +312,72 @@ in (tissue tissue). If no alias is found, NAME is returned as such." (() name))) (else name))) -(define (file-details file) - "Return a hashtable of details extracted from gemini FILE." +(define (file-details port) + "Return a hashtable of details extracted from input PORT reading a +gemtext file." (let ((result (make-eq-hashtable))) - ;; Files may be renamed or deleted, but not committed. Therefore, - ;; only read the file if it exists. - (when (file-exists? file) - (call-with-input-file file - (lambda (port) - (port-transduce (tmap (lambda (line) - (cond - ;; 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)))) - ((let ((alist (list-line->alist line))) - (and alist - ;; Every value string is 2 - ;; words or less. - (every (match-lambda - ((_ . values) - (every (cut <=n-words? <> 2) - values))) - alist) - alist)) - => (lambda (alist) - ;; Insert values based on - ;; their keys. - (for-each (match-lambda - (((or 'assign 'assigned) . values) - (hashtable-append! result 'assigned - (map (cut resolve-alias <> (%aliases)) - values))) - (((or 'keywords 'severity 'status 'priority 'tags 'type) . values) - (hashtable-append! result 'keywords values)) - (_ #t)) - alist))) - ;; A more fuzzy heuristic to find keywords - ((and (string-prefix? "* " line) - ;; Is every comma-separated - ;; element two words utmost? - (every (cut <=n-words? <> 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)))) - ;; 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)))) + (port-transduce (tmap (lambda (line) + (cond + ;; 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)))) + ((let ((alist (list-line->alist line))) + (and alist + ;; Every value string is 2 + ;; words or less. + (every (match-lambda + ((_ . values) + (every (cut <=n-words? <> 2) + values))) + alist) + alist)) + => (lambda (alist) + ;; Insert values based on + ;; their keys. + (for-each (match-lambda + (((or 'assign 'assigned) . values) + (hashtable-append! result 'assigned + (map (cut resolve-alias <> (%aliases)) + values))) + (((or 'keywords 'severity 'status 'priority 'tags 'type) . values) + (hashtable-append! result 'keywords values)) + (_ #t)) + alist))) + ;; A more fuzzy heuristic to find keywords + ((and (string-prefix? "* " line) + ;; Is every comma-separated + ;; element two words utmost? + (every (cut <=n-words? <> 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)))) + ;; 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) result)) (define file-modification-table-for-current-repository @@ -390,7 +386,8 @@ in (tissue tissue). If no alias is found, NAME is returned as such." (define (read-gemtext-issue file) "Read issue from gemtext FILE. Return an <issue> object." - (let* ((file-details (file-details file)) + (let* ((file-details (call-with-file-in-git (current-git-repository) file + file-details)) ;; Downcase keywords to make them ;; case-insensitive. (all-keywords (map string-downcase |