diff options
| -rwxr-xr-x | bin/tissue | 1 | ||||
| -rw-r--r-- | tissue/document.scm | 80 | ||||
| -rw-r--r-- | tissue/file-document.scm | 99 | ||||
| -rw-r--r-- | tissue/issue.scm | 1 |
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) |