diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rwxr-xr-x | bin/tissue | 86 | ||||
| -rw-r--r-- | tissue/file-document.scm | 4 | ||||
| -rw-r--r-- | tissue/git.scm | 22 | ||||
| -rw-r--r-- | tissue/issue.scm | 2 |
5 files changed, 48 insertions, 67 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 38e25e1..ecfaf0e 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -7,7 +7,6 @@ (indent-tabs-mode t)) (scheme-mode (eval . (put 'call-with-current-directory 'scheme-indent-function 1)) - (eval . (put 'call-with-file-in-git 'scheme-indent-function 2)) (eval . (put 'call-with-temporary-checkout 'scheme-indent-function 1)) (eval . (put 'function-documentation 'scheme-indent-function 2)) (eval . (put 'docstring-function-documentation 'scheme-indent-function 2)) @@ -108,7 +108,7 @@ Show the text of FILE. " (command-line-program))) ((file) - (call-with-file-in-git (current-git-repository) file + (call-with-input-file file (lambda (port) (port-transduce (compose @@ -152,7 +152,7 @@ Show the text of FILE. (define (load-config) "Load configuration and return <tissue-configuration> object." - (call-with-file-in-git (current-git-repository) "tissue.scm" + (call-with-input-file "tissue.scm" (compose eval-string get-string-all))) (define tissue-repl @@ -278,7 +278,10 @@ Serve repositories specified in CONFIG-FILE over HTTP. (parameterize ((%current-git-repository (repository-open repository-directory))) (cons name - `((project . ,(load-config)) + `((project . ,(call-with-temporary-checkout repository-directory + (lambda (temporary-checkout) + (call-with-current-directory temporary-checkout + load-config)))) (repository-directory . ,repository-directory) (website-directory . ,(string-append state-directory "/" name "/website")) (xapian-directory . ,(string-append state-directory "/" name "/xapian")) @@ -401,44 +404,45 @@ HOSTNAME." (format (current-error-port) "Cloned upstream repository.~%") repository))))) - (let ((config (load-config))) - (parameterize ((%aliases (tissue-configuration-aliases config))) - (call-with-temporary-checkout (git-top-level) - (lambda (temporary-repository-clone) - ;; Add the top level of the git repository to the - ;; load path since there may be user-written - ;; modules in the repository. - ;; TODO: Though not strictly required, it would - ;; be better to remove the added load path once - ;; done. - (add-to-load-path temporary-repository-clone) - ;; Index. - (unless (file-exists? "xapian") - (mkdir "xapian")) - (let ((xapian-directory (canonicalize-path "xapian"))) - (call-with-current-directory temporary-repository-clone - (cut index - xapian-directory - (tissue-configuration-indexed-documents config))) - (format (current-error-port) - "Indexed latest changes.~%")) - ;; Build website. - (let ((website-directory "website")) - (guard (c (else (format (current-error-port) - "Building website failed.~%") - (raise c))) - (call-with-temporary-directory - (lambda (temporary-output-directory) - (call-with-current-directory temporary-repository-clone - (cut build-website - temporary-output-directory - (tissue-configuration-web-files config))) - (delete-file-recursively website-directory) - (rename-file temporary-output-directory - website-directory))) - (chmod website-directory #o755) - (format (current-error-port) - "Built website.~%")))))))))))))) + (call-with-temporary-checkout (git-top-level) + (lambda (temporary-repository-clone) + (let ((config (call-with-current-directory temporary-repository-clone + load-config))) + (parameterize ((%aliases (tissue-configuration-aliases config))) + ;; Add the top level of the git repository to the + ;; load path since there may be user-written + ;; modules in the repository. + ;; TODO: Though not strictly required, it would + ;; be better to remove the added load path once + ;; done. + (add-to-load-path temporary-repository-clone) + ;; Index. + (unless (file-exists? "xapian") + (mkdir "xapian")) + (let ((xapian-directory (canonicalize-path "xapian"))) + (call-with-current-directory temporary-repository-clone + (cut index + xapian-directory + (tissue-configuration-indexed-documents config))) + (format (current-error-port) + "Indexed latest changes.~%")) + ;; Build website. + (let ((website-directory "website")) + (guard (c (else (format (current-error-port) + "Building website failed.~%") + (raise c))) + (call-with-temporary-directory + (lambda (temporary-output-directory) + (call-with-current-directory temporary-repository-clone + (cut build-website + temporary-output-directory + (tissue-configuration-web-files config))) + (delete-file-recursively website-directory) + (rename-file temporary-output-directory + website-directory))) + (chmod website-directory #o755) + (format (current-error-port) + "Built website.~%")))))))))))))) (define tissue-pull (match-lambda* diff --git a/tissue/file-document.scm b/tissue/file-document.scm index ccd6a48..f389976 100644 --- a/tissue/file-document.scm +++ b/tissue/file-document.scm @@ -71,7 +71,7 @@ (define (file-text file) "Return the contents of text @var{file}." - (call-with-file-in-git (current-git-repository) file + (call-with-input-file file get-string-all)) (define-method (document-text (document <file-document>)) @@ -139,7 +139,7 @@ MSet object representing a list of search results." "Read gemtext document from @var{file} and return a @code{<file-document>} object." (make <file-document> - #:title (or (call-with-file-in-git (current-git-repository) file + #:title (or (call-with-input-file file (lambda (port) (port-transduce (tfilter-map (lambda (line) ;; The first level one diff --git a/tissue/git.scm b/tissue/git.scm index 4289d65..70f0de9 100644 --- a/tissue/git.scm +++ b/tissue/git.scm @@ -45,7 +45,6 @@ commit-author-date git-tracked-file? git-tracked-files - call-with-file-in-git file-modification-table clone-options call-with-temporary-checkout)) @@ -132,27 +131,6 @@ directory." directory of @var{repository} and do not have a leading slash." (tree-list (head-tree repository))) -(define (call-with-file-in-git repository path proc) - "Call PROC on an input port reading contents of PATH. PATH may refer -to a file on the filesystem or in REPOSITORY." - (let ((file-path (if (absolute-file-name? path) - ;; Treat absolute paths verbatim. - path - ;; Treat relative paths as relative to the - ;; top-level of the git repository. - (string-append (dirname (repository-directory repository)) - "/" path)))) - (if (file-exists? file-path) - ;; If file exists on the filesystem, read it. - (call-with-input-file file-path proc) - ;; Else, read the file from the repository. - (let* ((path-tree-entry (tree-entry-bypath (head-tree repository) - path)) - (path-object (tree-entry->object repository path-tree-entry)) - (blob (blob-lookup repository (object-id path-object)))) - (call-with-port (open-bytevector-input-port (blob-content blob)) - proc))))) - (define (commit-file-changes repository commit) "Return a list of pairs describing files modified by COMMIT with respect to its first parent in REPOSITORY. Each pair maps the old diff --git a/tissue/issue.scm b/tissue/issue.scm index ebfca52..1953cef 100644 --- a/tissue/issue.scm +++ b/tissue/issue.scm @@ -277,7 +277,7 @@ gemtext file." "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. |