From 6fc9d81a96a6ae39a621806473cb0037bf98639b Mon Sep 17 00:00:00 2001
From: Wantao Liu <lwantaoo@qq.com>
Date: Mon, 14 Jul 2025 02:23:29 +0800
Subject: [PATCH] add(.workflow/build-web.scm): WIP

---
 .workflow/build-web.scm | 124 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 124 insertions(+)
 create mode 100644 .workflow/build-web.scm

diff --git a/.workflow/build-web.scm b/.workflow/build-web.scm
new file mode 100644
index 0000000..c331b6e
--- /dev/null
+++ b/.workflow/build-web.scm
@@ -0,0 +1,124 @@
+(define (src-dir) 
+  (path-absolute (path-join (current-directory) "src")))
+
+(define (dest-dir)
+  (path-absolute (path-join (current-directory) "web")))
+
+(define (git-date fname)
+  (let* ((cmd (format #f "git log --pretty=%at -- ~a | head -1" (path-quote fname)))
+    (call-with-process cmd
+      (lambda (port)
+        (let ((str (read-line port)))
+          (if (and (process-success? port) (not (eof-object? str)))
+              (string->number str)
+              (file-mtime fname))))))))
+
+(define (collect-articles dir)
+  (map 
+    (lambda (fpath)
+      (let* ((fname (path-basename fpath))
+            (doc (call-with-input-file fpath
+                   (lambda (port) (texmacs-parse port))))
+            (title (or (texmacs-select doc 'chapter*) "(no title)"))
+            (abs (or (texmacs-select doc 'notes-abstract) "(no abstract)"))
+            (mdate (file-mtime fpath))
+            (gdate (git-date fpath))
+            (cdate (file-ctime fpath)))
+        (list gdate cdate fname title abs)))
+    (directory-files dir "*.tmu" #:recursive? #f)))
+
+(define (make-article-list-entry mdate cdate file title abs)
+  `(notes-entry 
+     (file ,file)
+     (title ,title)
+     (abstract ,abs)
+     (last-modified ,(time->string mdate "%c %Z"))))
+
+(define (make-article-list dir)
+  (let* ((all-articles (collect-articles dir))
+         (sorted (sort all-articles (lambda (a b) (> (car a) (car b)))))
+    (filter (lambda (article) 
+              (not (member (path-basename (caddr article)) 
+                          '("list-articles.tmu" "main.tmu"))))
+            sorted))))
+
+(define (output-article-list-doc articles)
+  (let ((output-file (path-join (src-dir) "list-articles.tmu")))
+    (call-with-output-file output-file
+      (lambda (port)
+        (texmacs-serialize port
+          `(document
+             (TeXmacs ,(texmacs-version))
+             (style (tuple "notes"))
+             (body
+               (document
+                 (notes-header)
+                 (chapter* "List of all the articles")
+                 (notes-abstract "A list of all articles ordered by modification time")
+                 (hrule)
+                 ,@(map (lambda (a) (apply make-article-list-entry a)) articles)
+                 (hrule)))))))))
+
+(define (make-atom-entry mdate cdate file title abs)
+  (let ((base-url "http://texmacs.github.io/notes/docs/")
+        (file-base (path-basename file ".tmu")))
+    `(entry
+       (title ,title)
+       (link (@ (rel "alternate") (type "text/html") (hreflang "en")
+             (href ,(string-append base-url file-base ".html")))
+       (id ,(format #f "texmacs.github.io/notes/~a:~a" 
+                    file-base 
+                    (time->string mdate "%Y-%m-%dT%H:%M:%SZ")))
+       (updated ,(time->string mdate "%Y-%m-%dT%H:%M:%SZ"))
+       (published ,(time->string cdate "%Y-%m-%dT%H:%M:%SZ"))
+       ,@(if (string=? abs "(no abstract)") 
+             '() 
+             `((summary ,abs)))))))
+
+(define (output-article-feed articles)
+  (let ((atom-file (path-join (dest-dir) "tmmlwiki.atom")))
+    (call-with-output-file atom-file
+      (lambda (port)
+        (xml-serialize port
+          `(feed (@ (xmlns "http://www.w3.org/2005/Atom") (xml:lang "zh"))
+            (title "tmmlwiki")
+            (link (@ (rel "alternate") (type "text/html")
+                  (href "http://xmacslabs.github.io/tmmlwiki"))
+            (link (@ (rel "self") (type "application/atom+xml")
+                  (href "http://xmacslabs.github.io/tmmlwiki/web/tmmlwiki.atom"))
+            (updated ,(time->string (current-time) "%Y-%m-%dT%H:%M:%SZ"))
+            (author 
+              (name "The XmacsLabs organisation")
+              (uri "http://www.texmacs.org"))
+            (id "xmacslabs.github.io/tmmlwiki,2025,7")
+            (icon "https://avatars.githubusercontent.com/u/60380796?s=200&v=4")
+            (logo "https://avatars.githubusercontent.com/u/60380796?s=200&v=4")
+            ,@(map (lambda (a) (apply make-atom-entry a)) articles)))))))))
+
+(define (notes-run update?)
+  (display "Source dir: " (src-dir) "\n")
+  (display "Dest dir:   " (dest-dir) "\n")
+  
+  (let ((articles (make-article-list (src-dir))))
+    (display "* Making article list\n")
+    (output-article-list-doc articles)
+    
+    (display "* Making article feed\n")
+    (output-article-feed articles)
+    
+    (display "* " (if update? "Updating" "Building") " website\n")
+    (if update?
+        (tmweb-update-dir (src-dir) (dest-dir))
+        (tmweb-convert-dir (src-dir) (dest-dir)))
+  
+  (display "Done.\n")))
+
+(define (notes-update) (notes-run #t))
+(define (notes-build) (notes-run #f))
+
+;; 命令行接口
+(define (main args)
+  (cond
+    ((member "--update" args) (notes-update))
+    ((member "--build" args) (notes-build))
+    (else (notes-build))))
\ No newline at end of file
-- 
Gitee