Add fetch file procedure.

1 files changed, 18 insertions, 1 deletions

diff --git a/web/view/markdown.scm b/web/view/markdown.scm
index 2af2b26..fac9a98 100644
--- a/web/view/markdown.scm
+++ b/web/view/markdown.scm
@@ -6,24 +6,28 @@
   #:use-module (ice-9 receive)
   #:use-module (ice-9 string-fun)
   #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 exceptions)
   #:use-module (sxml simple)
   #:use-module (web client)
   #:use-module (web uri)
   #:use-module (web request)
+  
   #:use-module (web sxml)
   #:use-module (commonmark)
 
   #:export (markdown-file->sxml
 	    markdown-github->sxml
+	    fetch-file
 	    fetch-raw-file)
   )
 
 
+
 (define (markdown-file->sxml fn)
   "Parse a local file"
   (commonmark->sxml
    (call-with-input-file fn
-       get-string-all)))
+     get-string-all)))
 
 ;; --- fetch github style URLs
 
@@ -53,3 +57,16 @@
 		(a (@ (href ,(form-github-edit-url project repo page)) (role "button")) "edit")))
 	  (br)
 	  (br))))
+
+
+
+(define (fetch-file repo query_path)
+  (let* ( (abs_path (string-append repo "/" query_path)))
+	    (if (file-exists? abs_path)  (let* ((full_path (canonicalize-path abs_path))
+						(content (call-with-input-file full_path get-string-all))
+						)
+					   `(("path" . ,query_path)
+					     ("content" . ,content)
+					     ("hash" . "commit hash here"))
+					   ) (throw 'file-error  (string-append "the file path " abs_path " does not exists")))
+	    ))