summaryrefslogtreecommitdiff
path: root/tissue/issue.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tissue/issue.scm')
-rw-r--r--tissue/issue.scm127
1 files changed, 29 insertions, 98 deletions
diff --git a/tissue/issue.scm b/tissue/issue.scm
index 469b033..14bd75f 100644
--- a/tissue/issue.scm
+++ b/tissue/issue.scm
@@ -1,5 +1,5 @@
;;; tissue --- Text based issue tracker
-;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022 Frederick Muriuki Muriithi <fredmanglis@gmail.com>
;;;
;;; This file is part of tissue.
@@ -27,7 +27,6 @@
#:use-module (ice-9 regex)
#:use-module (oop goops)
#:use-module (term ansi-color)
- #:use-module (git)
#:use-module (web uri)
#:use-module (xapian xapian)
#:use-module (tissue document)
@@ -48,8 +47,7 @@
print-issue
print-issue-to-gemtext
issues
- read-gemtext-issue
- index-issue))
+ read-gemtext-issue))
(define-class <issue> (<file-document>)
(assigned #:accessor issue-assigned #:init-keyword #:assigned)
@@ -58,18 +56,26 @@
(tasks #:accessor issue-tasks #:init-keyword #:tasks)
(completed-tasks #:accessor issue-completed-tasks #:init-keyword #:completed-tasks))
+(define-method (document-type (issue <issue>))
+ "issue")
+
(define-method (document-boolean-terms (issue <issue>))
"Return the boolean terms in ISSUE."
- (append (list (string-append "A" (file-document-creator issue))
- (string-append "XA" (file-document-last-updater issue))
- (string-append "XS" (if (issue-open? issue)
+ (append (list (string-append "XS" (if (issue-open? issue)
"open" "closed")))
- (map (cut string-append "XI" <>)
- (issue-assigned issue))
(map (cut string-append "K" <>)
(issue-keywords issue))
(next-method)))
+(define-method (document-term-generator (issue <issue>))
+ "Return a term generator indexing ISSUE."
+ (let ((term-generator (next-method)))
+ (index-text! term-generator (file-document-creator issue) #:prefix "A")
+ (index-text! term-generator (file-document-last-updater issue) #:prefix "XA")
+ (for-each (cut index-text! term-generator <> #:prefix "XI")
+ (issue-assigned issue))
+ term-generator))
+
(define-method (print (issue <issue>) mset port)
"Print ISSUE, an <issue> object, in search results."
(let ((number-of-posts (length (file-document-commits issue))))
@@ -160,89 +166,6 @@
(newline)
(newline)))
-(define (sanitize-string str)
- "Downcase STR and replace spaces with hyphens."
- (string-map (lambda (c)
- (case c
- ((#\space) #\-)
- (else c)))
- (string-downcase str)))
-
-(define-method (document->sxml (issue <issue>) mset)
- "Render ISSUE, an <issue> object, to SXML. MSET is the xapian MSet
-object representing a list of search results."
- `(li (@ (class ,(string-append "search-result search-result-issue "
- (if (issue-open? issue)
- "search-result-open-issue"
- "search-result-closed-issue"))))
- (a (@ (href ,(document-web-uri issue))
- (class "search-result-title"))
- ,(document-title issue))
- (ul (@ (class "tags"))
- ,@(map (lambda (tag)
- (let ((words (string-split tag (char-set #\- #\space))))
- `(li (@ (class
- ,(string-append "tag"
- (string-append " tag-" (sanitize-string tag))
- (if (not (null? (lset-intersection
- string=? words
- (list "bug" "critical"))))
- " tag-bug"
- "")
- (if (not (null? (lset-intersection
- string=? words
- (list "progress"))))
- " tag-progress"
- "")
- (if (not (null? (lset-intersection
- string=? words
- (list "chore"))))
- " tag-chore"
- "")
- (if (not (null? (lset-intersection
- string=? words
- (list "enhancement" "feature"))))
- " tag-feature"
- ""))))
- (a (@ (href ,(string-append
- "/search?query="
- (uri-encode
- ;; Quote tag if it has spaces.
- (string-append "tag:"
- (if (string-any #\space tag)
- (string-append "\"" tag "\"")
- tag))))))
- ,tag))))
- (issue-keywords issue)))
- (div (@ (class "search-result-metadata"))
- (span (@ (class ,(string-append "document-type issue-document-type "
- (if (issue-open? issue)
- "open-issue-document-type"
- "closed-issue-document-type"))))
- ,(if (issue-open? issue)
- "issue"
- "✓ issue"))
- ,(string-append
- (format #f " opened ~a by ~a"
- (human-date-string (file-document-created-date issue))
- (file-document-creator issue))
- (if (> (length (file-document-commits issue))
- 1)
- (format #f ", last updated ~a by ~a"
- (human-date-string (file-document-last-updated-date issue))
- (file-document-last-updater issue))
- "")
- (if (zero? (issue-tasks issue))
- ""
- (format #f "; ~a of ~a tasks done"
- (issue-completed-tasks issue)
- (issue-tasks issue)))))
- ,@(let ((snippet (document-sxml-snippet issue mset)))
- (if snippet
- (list `(div (@ (class "search-result-snippet"))
- ,@snippet))
- (list)))))
-
(define (hashtable-prepend! hashtable key new-values)
"Prepend NEW-VALUES to the list of values KEY is associated to in
HASHTABLE. Deduplicate the resulting list if necessary. If KEY is not
@@ -291,17 +214,23 @@ return #f."
(define (file-details port)
"Return a hashtable of details extracted from input PORT reading a
gemtext file."
- (let ((result (make-eq-hashtable)))
+ (let ((result (make-eq-hashtable))
+ (in-preformatted #f))
(port-transduce (tmap (lambda (line)
(cond
+ ;; Toggle preformatted state.
+ ((string=? "```" line)
+ (set! in-preformatted (not in-preformatted)))
+ ;; Ignore preformatted blocks.
+ (in-preformatted #t)
;; Checkbox lists are tasks. If the
;; checkbox has any character other
;; than space in it, the task is
;; completed.
- ((string-match "^\\* \\[(.)\\]" line)
+ ((string-match "^\\* \\[(.*)\\]" line)
=> (lambda (m)
(hashtable-update! result 'tasks 1+ 0)
- (unless (string=? (match:substring m 1) " ")
+ (unless (string-blank? (match:substring m 1))
(hashtable-update! result 'completed-tasks 1+ 0))))
((list-line->alist line)
=> (lambda (alist)
@@ -350,9 +279,10 @@ gemtext file."
result))
(define (read-gemtext-issue file)
- "Read issue from gemtext FILE. Return an <issue> object."
+ "Read issue from gemtext @var{file} and return an @code{<issue>}
+object."
(let* ((file-document (read-gemtext-document file))
- (file-details (call-with-file-in-git (current-git-repository) file
+ (file-details (call-with-input-file file
file-details))
;; Downcase keywords to make them
;; case-insensitive.
@@ -370,4 +300,5 @@ gemtext file."
#:open? (not (member "closed" all-keywords))
#:tasks (hashtable-ref file-details 'tasks 0)
#:completed-tasks (hashtable-ref file-details 'completed-tasks 0)
- #:commits (file-document-commits file-document))))
+ #:commits (file-document-commits file-document)
+ #:snippet-source-text (document-snippet-source-text file-document))))
generated by cgit v1.2.3 (git 2.44.0) at 2024-05-05 14:12:12 +0000