diff options
| -rwxr-xr-x | bin/tissue | 49 | ||||
| -rw-r--r-- | tissue/tissue.scm | 14 |
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 ...) |