Move index-page to pages

Evgeny PisemskyFri Sep 06 10:40:10+0300 2024

40eb7db

Move index-page to pages

gitile/handler.scm

9191 
  (name project-name)
9292 
  (description project-description))
9393 
94-
(define (index-page projects base-git-url title intro footer)
95-
  (pk 'projects projects)
96-
  `(html
97-
     (head
98-
       (meta (@ (charset "UTF-8")))
99-
       (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
100-
       (link (@ (rel "stylesheet") (href "/css/git.css")))
101-
       (link (@ (rel "icon") (href "/images/icon.png") (sizes "32x32")))
102-
       (title ,title))
103-
     (body (@ (lang "en"))
104-
       (header (@ (id "intro"))
105-
         (h1 "Every project")
106-
         ,@intro
107-
         (p (@ (id "mire"))
108-
            (span (@ (class "blue")) "")
109-
            (span (@ (class "red")) "")
110-
            (span (@ (class "green")) "")
111-
            (span (@ (class "orange")) "")))
112-
       (div (@ (id "content"))
113-
         (div (@ (id "project-list"))
114-
           ,@(map
115-
               (lambda (project)
116-
                 `(div (@ (class "project"))
117-
                    (h1 (a (@ (href ,(string-append "/" (project-slug project))))
118-
                           ,(project-name project)))
119-
                    ,@(match (xml->sxml (string-append "<d>" (project-description project) "</d>"))
120-
                        (('*TOP* ('d content ...))
121-
                         content))
122-
                    (div (@ (class "instructions"))
123-
                         (code "git clone " ,base-git-url "/"
124-
                               ,(project-slug project)))))
125-
               projects)))
126-
       (footer ,@footer))))
127-
12894 
(define* (show page #:key (code 200))
12995 
  (values (build-response #:code code #:headers '((content-type . (text/html))))
13096 
          (with-output-to-string (lambda _ (sxml->xml page)))))
…
240206 
       (let-values (((project-name path) (find-project-component request)))
241207 
         (match (cons project-name path)
242208 
           (("" . ())
243-
            (show (index-page (projects) base-git-url index-title intro footer)))
209+
            (show (index-page (projects) <project> base-git-url index-title intro footer)))
244210 
           ((project-name)
245211 
            (call-with-repo project-name
246212 
              (lambda (repo)
gitile/pages.scm
3131 
  #:use-module (rnrs bytevectors)
3232 
  #:use-module (srfi srfi-1)
3333 
  #:use-module (srfi srfi-19)
34+
  #:use-module (sxml simple)
3435 
  #:use-module (system foreign)
3536 
  #:use-module (web uri)
36-
  #:export (project-file-raw
37+
  #:export (index-page
38+
            style
39+
            project-file-raw
3740 
            project-files
3841 
            project-index
3942 
            project-commits
4043 
            project-commit
41-
            project-tags
42-
            style))
44+
            project-tags))
45+
46+
(define (index-page projects project-type base-git-url title intro footer)
47+
  `(html
48+
    (head
49+
     (meta (@ (charset "UTF-8")))
50+
     (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
51+
     (link (@ (rel "stylesheet") (href "/css/git.css")))
52+
     (link (@ (rel "icon") (href "/images/icon.png") (sizes "32x32")))
53+
     (title ,title))
54+
    (body (@ (lang "en"))
55+
          (header (@ (id "intro"))
56+
                  (h1 "Every project")
57+
                  ,@intro
58+
                  (p (@ (id "mire"))
59+
                     (span (@ (class "blue")) "")
60+
                     (span (@ (class "red")) "")
61+
                     (span (@ (class "green")) "")
62+
                     (span (@ (class "orange")) "")))
63+
          (div (@ (id "content"))
64+
               (div (@ (id "project-list"))
65+
                    ,@(map
66+
                       (match-lambda
67+
                         (($ project-type slug name description)
68+
                          `(div (@ (class "project"))
69+
                                (h1 (a (@ (href ,(string-append "/" slug)))
70+
                                       ,(if (string-null? name) slug name)))
71+
                                ,@(match (xml->sxml (string-append "<d>" description "</d>"))
72+
                                    (('*TOP* ('d content ...))
73+
                                     content))
74+
                                (div (@ (class "instructions"))
75+
                                     (code "git clone " ,base-git-url "/" ,slug)))))
76+
                       projects)))
77+
          (footer ,@footer))))
78+
79+
(define (style page project ref footer)
80+
  `(html
81+
     (head
82+
       (meta (@ (charset "UTF-8")))
83+
       (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
84+
       (link (@ (rel "stylesheet") (href "/css/gitile.css")))
85+
       (link (@ (rel "stylesheet") (href "/css/highlight.css")))
86+
       (link (@ (rel "icon") (href "/images/icon.png") (sizes "32x32")))
87+
       (script (@ (src "/js/gitile.js")) "")
88+
       (title ,project))
89+
     (body
90+
       (header
91+
         (nav
92+
           (ul
93+
             (li (@ (class "first")) (a (@ (href "/")) "Projects"))
94+
             (li (a (@ (href "/" ,project)) "Repository"))
95+
             (li (a (@ (href "/" ,project "/tree/" ,ref)) "Files"))
96+
             (li (a (@ (href "/" ,project "/commits")) "Commits"))
97+
             (li (a (@ (href "/" ,project "/tags")) "Tags")))))
98+
       (div (@ (id "content"))
99+
            ,@page)
100+
       (footer ,@footer))))
43101 
44102 
(define* (project-file-raw repo path #:key (ref "-"))
45103 
  (let* ((ref (if (equal? ref "-") #f ref))
…
337395 
               (loop lines (+ old-line 1) (+ new-line 1))))))
338396 
        0))
339397 
    (append content (cons file-header `((table (@ (class "file-diff")) ,file-content))))))
340-
341-
(define (style page project ref footer)
342-
  `(html
343-
     (head
344-
       (meta (@ (charset "UTF-8")))
345-
       (meta (@ (name "viewport") (content "width=device-width, initial-scale=1")))
346-
       (link (@ (rel "stylesheet") (href "/css/gitile.css")))
347-
       (link (@ (rel "stylesheet") (href "/css/highlight.css")))
348-
       (link (@ (rel "icon") (href "/images/icon.png") (sizes "32x32")))
349-
       (script (@ (src "/js/gitile.js")) "")
350-
       (title ,project))
351-
     (body
352-
       (header
353-
         (nav
354-
           (ul
355-
             (li (@ (class "first")) (a (@ (href "/")) "Projects"))
356-
             (li (a (@ (href "/" ,project)) "Repository"))
357-
             (li (a (@ (href "/" ,project "/tree/" ,ref)) "Files"))
358-
             (li (a (@ (href "/" ,project "/commits")) "Commits"))
359-
             (li (a (@ (href "/" ,project "/tags")) "Tags")))))
360-
       (div (@ (id "content"))
361-
            ,@page)
362-
       (footer ,@footer))))