summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/tissue1
-rw-r--r--tissue/document.scm80
-rw-r--r--tissue/file-document.scm99
-rw-r--r--tissue/issue.scm1
4 files changed, 107 insertions, 74 deletions
diff --git a/bin/tissue b/bin/tissue
index 6e82b5b..2170501 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -39,6 +39,7 @@ exec guile --no-auto-compile -s "$0" "$@"
(xapian wrap)
(xapian xapian)
(tissue commit)
+ (tissue file-document)
(tissue document)
(tissue git)
(tissue issue)
diff --git a/tissue/document.scm b/tissue/document.scm
index ed69254..592c8c7 100644
--- a/tissue/document.scm
+++ b/tissue/document.scm
@@ -22,7 +22,6 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
- #:use-module (srfi srfi-171)
#:use-module (ice-9 match)
#:use-module (htmlprag)
#:use-module (oop goops)
@@ -44,10 +43,7 @@
document-snippet
print
document-sxml-snippet
- document->sxml
- <file-document>
- file-document-path
- read-gemtext-document))
+ document->sxml))
(define (slot-set object slot-name value)
"Set SLOT-NAME in OBJECT to VALUE. This is a purely functional setter
@@ -137,6 +133,11 @@ that operates on a copy of OBJECT. It does not mutate OBJECT."
(title #:accessor document-title #:init-keyword #:title)
(web-uri #:accessor document-web-uri #:init-keyword #:web-uri))
+(define-generic document-id-term)
+(define-generic document-text)
+(define-generic print)
+(define-generic document->sxml)
+
(define-method (document-type (document <document>))
(string-trim-both (symbol->string (class-name (class-of document)))
(char-set #\< #\>)))
@@ -158,28 +159,6 @@ and further text, increase-termpos! must be called before indexing."
(index-text! term-generator (document-text document))
term-generator))
-(define-class <file-document> (<document>)
- (path #:accessor file-document-path #:init-keyword #:path))
-
-(define-method (document-type (document <file-document>))
- (next-method))
-
-(define-method (document-id-term (document <file-document>))
- "Return the ID term for DOCUMENT."
- (string-append "Qfile." (file-document-path document)))
-
-(define-method (document-text (document <file-document>))
- "Return the full text of DOCUMENT."
- (call-with-file-in-git (current-git-repository) (file-document-path document)
- get-string-all))
-
-(define-method (document-term-generator (document <file-document>))
- "Return a term generator indexing DOCUMENT."
- (let ((term-generator (next-method)))
- (increase-termpos! term-generator)
- (index-text! term-generator (file-document-path document))
- term-generator))
-
(define-method (document-snippet-source-text (document <document>))
"Return the source text for DOCUMENT from which to extract a search
result snippet."
@@ -216,23 +195,6 @@ representing a list of search results."
children)
""))))
-(define-method (print (document <file-document>) mset port)
- "Print DOCUMENT in command-line search results. MSET is the xapian
-MSet object representing a list of search results."
- (display (colorize-string (document-title document) 'MAGENTA 'UNDERLINE)
- port)
- (newline port)
- (display (colorize-string "DOCUMENT" 'BOLD 'YELLOW) port)
- (display " " port)
- (display (colorize-string (file-document-path document) 'YELLOW)
- port)
- (newline port)
- (let ((snippet (document-snippet document mset)))
- (unless (string-null? snippet)
- (display snippet port)
- (newline port)
- (newline port))))
-
(define (document-sxml-snippet document mset)
"Return snippet in SXML form for DOCUMENT. MSET is the xapian MSet
object representing a list of search results."
@@ -251,33 +213,3 @@ object representing a list of search results."
(else
(list child))))
children))))
-
-(define-method (document->sxml (document <file-document>) mset)
- "Render DOCUMENT to SXML. MSET is the xapian MSet object representing
-a list of search results."
- `(li (@ (class "search-result search-result-document"))
- (a (@ (href ,(document-web-uri document))
- (class "search-result-title"))
- ,(document-title document))
- ,@(let ((snippet (document-sxml-snippet document mset)))
- (if snippet
- (list `(div (@ (class "search-result-snippet"))
- ,@snippet))
- (list)))))
-
-(define (read-gemtext-document file)
- "Reade gemtext document from FILE. Return a <file-document> object."
- (make <file-document>
- #:title (or (call-with-file-in-git (current-git-repository) file
- (lambda (port)
- (port-transduce (tfilter-map (lambda (line)
- ;; The first level one
- ;; heading is the title.
- (and (string-prefix? "# " line)
- (string-remove-prefix "# " line))))
- (rany identity)
- get-line-dos-or-unix
- port)))
- ;; Fallback to filename if document has no title.
- file)
- #:path file))
diff --git a/tissue/file-document.scm b/tissue/file-document.scm
new file mode 100644
index 0000000..b891b9d
--- /dev/null
+++ b/tissue/file-document.scm
@@ -0,0 +1,99 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; tissue is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with tissue. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (tissue file-document)
+ #:use-module (rnrs io ports)
+ #:use-module (srfi srfi-171)
+ #:use-module (oop goops)
+ #:use-module (term ansi-color)
+ #:use-module (tissue document)
+ #:use-module (tissue git)
+ #:use-module (tissue utils)
+ #:use-module (xapian xapian)
+ #:export (<file-document>
+ file-document-path
+ read-gemtext-document))
+
+(define-class <file-document> (<document>)
+ (path #:accessor file-document-path #:init-keyword #:path))
+
+(define-method (document-type (document <file-document>))
+ (next-method))
+
+(define-method (document-id-term (document <file-document>))
+ "Return the ID term for DOCUMENT."
+ (string-append "Qfile." (file-document-path document)))
+
+(define-method (document-text (document <file-document>))
+ "Return the full text of DOCUMENT."
+ (call-with-file-in-git (current-git-repository) (file-document-path document)
+ get-string-all))
+
+(define-method (document-term-generator (document <file-document>))
+ "Return a term generator indexing DOCUMENT."
+ (let ((term-generator (next-method)))
+ (increase-termpos! term-generator)
+ (index-text! term-generator (file-document-path document))
+ term-generator))
+
+(define-method (print (document <file-document>) mset port)
+ "Print DOCUMENT in command-line search results. MSET is the xapian
+MSet object representing a list of search results."
+ (display (colorize-string (document-title document) 'MAGENTA 'UNDERLINE)
+ port)
+ (newline port)
+ (display (colorize-string "DOCUMENT" 'BOLD 'YELLOW) port)
+ (display " " port)
+ (display (colorize-string (file-document-path document) 'YELLOW)
+ port)
+ (newline port)
+ (let ((snippet (document-snippet document mset)))
+ (unless (string-null? snippet)
+ (display snippet port)
+ (newline port)
+ (newline port))))
+
+(define-method (document->sxml (document <file-document>) mset)
+ "Render DOCUMENT to SXML. MSET is the xapian MSet object representing
+a list of search results."
+ `(li (@ (class "search-result search-result-document"))
+ (a (@ (href ,(document-web-uri document))
+ (class "search-result-title"))
+ ,(document-title document))
+ ,@(let ((snippet (document-sxml-snippet document mset)))
+ (if snippet
+ (list `(div (@ (class "search-result-snippet"))
+ ,@snippet))
+ (list)))))
+
+(define (read-gemtext-document file)
+ "Reade gemtext document from FILE. Return a <file-document> object."
+ (make <file-document>
+ #:title (or (call-with-file-in-git (current-git-repository) file
+ (lambda (port)
+ (port-transduce (tfilter-map (lambda (line)
+ ;; The first level one
+ ;; heading is the title.
+ (and (string-prefix? "# " line)
+ (string-remove-prefix "# " line))))
+ (rany identity)
+ get-line-dos-or-unix
+ port)))
+ ;; Fallback to filename if document has no title.
+ file)
+ #:path file))
diff --git a/tissue/issue.scm b/tissue/issue.scm
index ac397b4..ac7ae5c 100644
--- a/tissue/issue.scm
+++ b/tissue/issue.scm
@@ -31,6 +31,7 @@
#:use-module (web uri)
#:use-module (xapian xapian)
#:use-module (tissue document)
+ #:use-module (tissue file-document)
#:use-module (tissue git)
#:use-module (tissue person)
#:use-module (tissue utils)