summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/tissue49
-rw-r--r--tissue/tissue.scm14
2 files changed, 50 insertions, 13 deletions
diff --git a/bin/tissue b/bin/tissue
index 06da565..63b5682 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -38,6 +38,7 @@ exec guile --no-auto-compile -s "$0" "$@"
(xapian wrap)
(xapian xapian)
(tissue conditions)
+ (prefix (tissue document) doc:)
(tissue git)
(tissue issue)
(tissue tissue)
@@ -92,6 +93,14 @@ 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))))
@@ -165,6 +174,23 @@ to run tissue."
(newline)
(newline)))
+(define (alist->document alist)
+ "Convert ALIST to an <issue> or <document> object."
+ ((case (assq-ref alist 'type)
+ ((issue) alist->issue)
+ ((document) doc:alist->document)
+ (else (raise (unknown-document-type-violation alist))))
+ alist))
+
+(define (document->text document)
+ "Return the text of DOCUMENT, an <issue> or <document> object."
+ (call-with-input-file
+ ((cond
+ ((issue? document) issue-file)
+ ((doc:document? document) doc:document-file)
+ (else (raise (unknown-document-type-violation document))))
+ document)
+ get-string-all))
(define tissue-search
(match-lambda*
@@ -203,12 +229,11 @@ Search issues using SEARCH-QUERY.
("is" . "XS")))))
(format #t "total ~a~%"
(mset-fold (lambda (item count)
- (let ((issue (call-with-input-string (document-data (mset-item-document item))
- (compose alist->issue read))))
- (print-issue issue)
+ (let ((document (call-with-input-string (document-data (mset-item-document item))
+ (compose alist->document read))))
+ (print-document document)
(let ((snippet (mset-snippet (MSetIterator-mset-get item)
- (call-with-input-file (issue-file issue)
- get-string-all)
+ (document->text document)
#:length 200
#:highlight-start (color 'BOLD 'ON-RED)
#:highlight-end (color 'RESET)
@@ -349,6 +374,15 @@ top-level of the git repository."
(negate (cut member <> (list "." "..")))))
(rmdir %xapian-index)))
+(define (index-document db document)
+ "Index DOCUMENT, an <issue> or <document> object, in writable xapian
+DB."
+ ((cond
+ ((issue? document) index-issue)
+ ((doc:document? document) doc:index-document)
+ (else (raise (unknown-document-type-violation document))))
+ db document))
+
(define main
(match-lambda*
((_ (or "-h" "--help"))
@@ -382,8 +416,9 @@ top-level of the git repository."
(delete-xapian-index)
(call-with-writable-database %xapian-index
(lambda (db)
- (for-each (cut index-issue db <>)
- (issues))
+ (for-each (lambda (indexed-document)
+ (index-document db ((indexed-document-reader indexed-document))))
+ (tissue-configuration-indexed-documents (load-config)))
(WritableDatabase-set-metadata db "commit" current-head))))))
;; Handle sub-command.
(apply (match command
diff --git a/tissue/tissue.scm b/tissue/tissue.scm
index decd630..3bc6e41 100644
--- a/tissue/tissue.scm
+++ b/tissue/tissue.scm
@@ -25,18 +25,19 @@
tissue-configuration?
tissue-configuration-project
tissue-configuration-aliases
- tissue-configuration-issue-files
+ tissue-configuration-indexed-documents
tissue-configuration-web-css
tissue-configuration-web-tags-path
tissue-configuration-web-files
gemtext-files-in-directory))
(define-record-type <tissue-configuration>
- (make-tissue-configuration project aliases issue-files web-css web-tags-path web-files)
+ (make-tissue-configuration project aliases indexed-documents
+ web-css web-tags-path web-files)
tissue-configuration?
(project tissue-configuration-project)
(aliases tissue-configuration-aliases)
- (issue-files tissue-configuration-issue-files)
+ (indexed-documents tissue-configuration-indexed-documents)
(web-css tissue-configuration-web-css)
(web-tags-path tissue-configuration-web-tags-path)
(web-files delayed-tissue-configuration-web-files))
@@ -64,7 +65,7 @@ which directory they are in."
#:web-files))
#'(args ...))))
#`(apply (lambda* (#:key project (aliases '())
- (issue-files (gemtext-files-in-directory))
+ (indexed-documents '())
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.
@@ -73,7 +74,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.
+INDEXED-DOCUMENTS is a list of <indexed-documents> objects
+representing documents to index.
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
@@ -84,7 +86,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 issue-files web-css web-tags-path web-files))
+ (make-tissue-configuration project aliases indexed-documents web-css web-tags-path web-files))
(list #,@(append before
(syntax-case after ()
((web-files-key web-files rest ...)