diff --git a/Makefile b/Makefile index 74dd1355f63c64cbfa510a918e9d00e2c643c9fd..cbc47057eaa1f609daa401f36e06aabfe1ae4b53 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ serve: static: mkdir -p output/static - cp -rf content/static/* output/static +# cp -rf content/static/* output/static favicon: cp content/favicon.ico output/ diff --git a/globals.lisp b/globals.lisp index 46fa4b80ae3537d4483ac0f62ca4fd4b28c68bb6..5d531f42faf09397632df8c6233a0e2e36f1a537 100644 --- a/globals.lisp +++ b/globals.lisp @@ -1,79 +1,79 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(in-package :cl-site) - -(defparameter *LAYOUT-DIR* (asdf:system-relative-pathname :cl-site "layout/templates/") - "Pathname for location of template files.") - -(defparameter *OUTPUT-DIR* (asdf:system-relative-pathname :cl-site "output/") - "Pathname where the generated output should be written to.") - -;; @TO-DO: store layout name as global, generate js/css pathnames from it. -;; (More template-related variables may go here in the future) -(defparameter *DEFAULT-PAGE-TEMPLATE* "layout_2018.html" - "Default template to use unless another is explicitly specified.") - -;; @TO-DO: replace this with better css preprocessing. -(defparameter *STYLES-DIR* (asdf:system-relative-pathname :cl-site "layout/css/") - "Pathname for location and list of styles.") -(defparameter *STYLES* - (list "layout_2018.css") - "A list of strings representing relative filenames.") - -;; JS files - separate from static files, because they are processed differently -;; within the template. -(defparameter *SCRIPTS-DIR* (asdf:system-relative-pathname :cl-site "layout/js/") - "Pathname for location and list of scripts.") -(defparameter *SCRIPTS* - (list "scripts.js") - "A list of strings representing relative filenames.") - -;; General static files - images etc -(defparameter *STATIC-DIR* (asdf:system-relative-pathname :cl-site "layout/static/") - "Pathname for location of static files.") - -;; The only REQUIRED field is :content which must be the filename of the page content -;; The :content field will NOT be sent to the template. -;; @TO-DO: store fields within content files and parse them out. -(defparameter *PAGES-DIR* (asdf:system-relative-pathname :cl-site "content/") - "Pathname for location of page content.") -(defparameter *PRIVATE-KEYS* '(:slug :content)) - -;; Extra context for pages -(defparameter *PAGE-CONTEXT* - `(("about.html" ((:title . "Common-Lisp.net | About"))) - ("index.html" ((:title . "Welcome to Common-Lisp.net!"))) - ("faq.html" ((:title . "Frequently asked questions"))) - ("gitlab-migration-repository-mapping.html" ((:title . "GitLab migration"))) - ("gitlab-migration-status.html" ((:title . "Migration to GitLab"))) - ("independent-lists.html" ((:title . "Independent Mailing Lists"))) - ("orphaned-mailing-lists.html" ((:title . "Orphaned mailing lists"))) - ("orphaned-projects.html" ((:title . "Orphaned projects"))) - ("phub.html" ((:title . "Projects"))) - ("project-intro.html" ((:title . "Project Hosting"))))) - -(defun page-context (filename) - (cadr (assoc filename *page-context* :test 'equalp))) - -(defun page-title (filename) - (or (cdr (assoc :title (page-context filename))) - (format nil "Common-Lisp.net | ~a" - (string-capitalize - (pathname-name (pathname filename)))))) - -(defparameter *PAGES* - (mapcar (lambda (p) - (let ((context - (append (list (cons :content (file-namestring p))) - (page-context (file-namestring p))))) - (when (not (assoc :title context)) - (push (cons :title (page-title (file-namestring p))) - context)) - context)) - (directory (make-pathname :defaults *PAGES-DIR* - :name :wild - :type "html"))) - "Each page is an alist containing info to be sent to the template via the context.") - -;; Initialize global context (will be appended to all individual page contexts) -;; Used to store things like stylesheets, etc... -(defparameter *GLOBAL-CONTEXT* ()) +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(in-package :cl-site) + +(defparameter *LAYOUT-DIR* (asdf:system-relative-pathname :cl-site "layout/templates/") + "Pathname for location of template files.") + +(defparameter *OUTPUT-DIR* (asdf:system-relative-pathname :cl-site "output/") + "Pathname where the generated output should be written to.") + +;; @TO-DO: store layout name as global, generate js/css pathnames from it. +;; (More template-related variables may go here in the future) +(defparameter *DEFAULT-PAGE-TEMPLATE* "layout_2018.html" + "Default template to use unless another is explicitly specified.") + +;; @TO-DO: replace this with better css preprocessing. +(defparameter *STYLES-DIR* (asdf:system-relative-pathname :cl-site "layout/css/") + "Pathname for location and list of styles.") +(defparameter *STYLES* + (list "layout_2018.css") + "A list of strings representing relative filenames.") + +;; JS files - separate from static files, because they are processed differently +;; within the template. +(defparameter *SCRIPTS-DIR* (asdf:system-relative-pathname :cl-site "layout/js/") + "Pathname for location and list of scripts.") +(defparameter *SCRIPTS* + (list "scripts.js") + "A list of strings representing relative filenames.") + +;; General static files - images etc +(defparameter *STATIC-DIR* (asdf:system-relative-pathname :cl-site "content/static/") + "Pathname for location of static files.") + +;; The only REQUIRED field is :content which must be the filename of the page content +;; The :content field will NOT be sent to the template. +;; @TO-DO: store fields within content files and parse them out. +(defparameter *PAGES-DIR* (asdf:system-relative-pathname :cl-site "content/") + "Pathname for location of page content.") +(defparameter *PRIVATE-KEYS* '(:slug :content)) + +;; Extra context for pages +(defparameter *PAGE-CONTEXT* + `(("about.html" ((:title . "Common-Lisp.net | About"))) + ("index.html" ((:title . "Welcome to Common-Lisp.net!"))) + ("faq.html" ((:title . "Frequently asked questions"))) + ("gitlab-migration-repository-mapping.html" ((:title . "GitLab migration"))) + ("gitlab-migration-status.html" ((:title . "Migration to GitLab"))) + ("independent-lists.html" ((:title . "Independent Mailing Lists"))) + ("orphaned-mailing-lists.html" ((:title . "Orphaned mailing lists"))) + ("orphaned-projects.html" ((:title . "Orphaned projects"))) + ("phub.html" ((:title . "Projects"))) + ("project-intro.html" ((:title . "Project Hosting"))))) + +(defun page-context (filename) + (cadr (assoc filename *page-context* :test 'equalp))) + +(defun page-title (filename) + (or (cdr (assoc :title (page-context filename))) + (format nil "Common-Lisp.net | ~a" + (string-capitalize + (pathname-name (pathname filename)))))) + +(defparameter *PAGES* + (mapcar (lambda (p) + (let ((context + (append (list (cons :content (file-namestring p))) + (page-context (file-namestring p))))) + (when (not (assoc :title context)) + (push (cons :title (page-title (file-namestring p))) + context)) + context)) + (directory (make-pathname :defaults *PAGES-DIR* + :name :wild + :type "html"))) + "Each page is an alist containing info to be sent to the template via the context.") + +;; Initialize global context (will be appended to all individual page contexts) +;; Used to store things like stylesheets, etc... +(defparameter *GLOBAL-CONTEXT* ()) diff --git a/layout/static/imgs/lotusflower.png b/layout/static/imgs/lotusflower.png deleted file mode 100644 index f3d5be9b4d51c98e352692dea700b0b800616fc7..0000000000000000000000000000000000000000 Binary files a/layout/static/imgs/lotusflower.png and /dev/null differ diff --git a/process.lisp b/process.lisp index 469cb7706a58cc830f4024104ae608530919191d..9679971a2d08048ba8472f7b90748951dd1df89a 100644 --- a/process.lisp +++ b/process.lisp @@ -1,150 +1,146 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(in-package :cl-site) - -;; Copies/renders stylesheets + adds to global context -(defun process-styles () - (let - ((styles-list (mapcar - (lambda (s) (progn - (uiop:copy-file (make-path *STYLES-DIR* s) - (make-path *OUTPUT-DIR* s)) - (cons :location s))) - *STYLES*))) - (push (cons :styles styles-list) *GLOBAL-CONTEXT*))) - -;; Copies/renders script files + adds to global context -(defun process-scripts () nil) - -;; Copies/renders static assets (imgs, etc) -(defun process-static ()) - -#+nil -(defun process-static () - (let* - ((static-output-dir (merge-pathnames #P"static/" *OUTPUT-DIR*)) - (static-list (mapcar - (lambda (s) (progn - (uiop:copy-file (make-path *STATIC-DIR* s) - (make-path static-output-dir s)) - (cons :location s))) - (mapcar - (lambda (p) (file-namestring p)) - (directory (make-pathname :defaults *STATIC-DIR* - :name :wild - :type :wild)))))) - (push (cons :static static-list) *GLOBAL-CONTEXT*))) - -;; process-pages : Copies/renders pages - called last - - -(defun render-page (page template-path) - (let* - ((page-path (make-path *PAGES-DIR* page t)) - (output-path (make-path *OUTPUT-DIR* page t)) - (page-content (let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*)) - (mustache:*default-pathname-type* "html")) - (mustache:render* page-path))) - (page-context (remove-if (lambda (p) (find p *PRIVATE-KEYS*)) - (push (cons :page-content page-content) page) :key 'car))) - - (with-open-file (output-stream output-path - :direction :output - :if-exists :supersede) - (let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*)) - (mustache:*default-pathname-type* "html")) - (mustache:render template-path (append page-context *GLOBAL-CONTEXT*) - output-stream))))) - -(defun process-pages () - (format t "Processing pages..~%") - (generate-news) - (let ((template-path (pathname (merge-pathnames *LAYOUT-DIR* *DEFAULT-PAGE-TEMPLATE*)))) - (ensure-directories-exist *OUTPUT-DIR*) - (loop for page in *PAGES* - do - (format t "Generating ~A~%" (cdr (assoc :content page))) - (render-page page template-path)) - (format t "Done.~%"))) - -;; Process news - -(defparameter +edit-news-link+ "https://gitlab.common-lisp.net/clo/cl-site/edit/master/content/news.md") - -(defun generate-news () - (let ((html - (markdown:parse-file (merge-pathnames "news.md" *PAGES-DIR*)))) - (with-open-file (f (merge-pathnames "news.html" *PAGES-DIR*) - :direction :output - :if-does-not-exist :create - :if-exists :supersede) - (write-string "<div id=\"bodyText\">" f) - (format f "<a class=\"btn btn-secondary float-right\" href=\"~A\"><i class=\"far fa-edit\"></i> Edit this page</a>" +edit-news-link+) - (write-string "<h1>Latest Common-Lisp.net news</h1>" f) - (write-string html f) - (write-string "</div>" f)) - (with-open-file (f (merge-pathnames "newsbox.html" *PAGES-DIR*) - :direction :output - :if-does-not-exist :create - :if-exists :supersede) - (write-string (generate-news-box-content html) f)))) - -(defun shallow-copy-object (original) - (let* ((class (class-of original)) - (copy (allocate-instance class))) - (dolist (slot (mapcar #'c2mop:slot-definition-name (c2mop:class-slots class))) - (when (slot-boundp original slot) - (setf (slot-value copy slot) - (slot-value original slot)))) - copy)) - -(defun generate-news-box-content (html &key (count 5)) - (let ((dom (plump-parser:parse html))) - (let ((state :start) - (node (plump:first-child dom)) - (news (plump:make-root)) - (current-news)) - (block done - (flet ((next-node () - (setf node (plump:next-sibling node)) - (when (null node) - ;;(print "DONE") - (return-from done)) - node)) - (loop - ;;(print state) - ;;(print node) - (ecase state - (:start - (if (and (plump:element-p node) - (equalp (plump:tag-name node) "h3")) - (setf state :read-news-heading) - ;; else - (next-node))) - - (:read-news-heading - - ;; If enough news, exit - (when (= (length (plump:children news)) count) - (return-from done)) - - ;; Start a new one - (setf current-news - (plump:make-element news "section")) - - (let ((title-node (shallow-copy-object node))) - (setf (plump:tag-name title-node) "h7") - (plump:append-child current-news title-node)) - (next-node) - (setf state :read-news-content)) - - (:read-news-content - ;; We assume the node is a paragraph and we read its content - (if (and (plump:element-p node) - (equalp (plump:tag-name node) "p")) - (progn - (plump:append-child current-news (shallow-copy-object node)) - (next-node) - (setf state :start)) - ;; else - (next-node))))))) - (plump:serialize news nil)))) +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(in-package :cl-site) + +;; Copies/renders stylesheets + adds to global context +(defun process-styles () + (let + ((styles-list (mapcar + (lambda (s) (progn + (uiop:copy-file (make-path *STYLES-DIR* s) + (make-path *OUTPUT-DIR* s)) + (cons :location s))) + *STYLES*))) + (push (cons :styles styles-list) *GLOBAL-CONTEXT*))) + +;; Copies/renders script files + adds to global context +(defun process-scripts () nil) + +;; Copies/renders static assets (imgs, etc) +(defun process-static () + (let ((destination-root (merge-pathnames #P"static/" *output-dir*)) + (sources (directory (merge-pathnames "**/*.*" *static-dir*))) + static-list) + (dolist (source sources) + (let* ((relative-path (enough-namestring source *static-dir*)) + (destination (merge-pathnames relative-path destination-root))) + (when (pathname-name destination) ;; ignore directories + (ensure-directories-exist destination) + (uiop:copy-file source destination) + (push (cons :location relative-path) static-list)))) + (push (cons :static (nreverse static-list)) + *global-context*))) + +;; process-pages : Copies/renders pages - called last + + +(defun render-page (page template-path) + (let* + ((page-path (make-path *PAGES-DIR* page t)) + (output-path (make-path *OUTPUT-DIR* page t)) + (page-content (let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*)) + (mustache:*default-pathname-type* "html")) + (mustache:render* page-path))) + (page-context (remove-if (lambda (p) (find p *PRIVATE-KEYS*)) + (push (cons :page-content page-content) page) :key 'car))) + + (with-open-file (output-stream output-path + :direction :output + :if-exists :supersede) + (let ((mustache:*load-path* (cons *PAGES-DIR* mustache:*load-path*)) + (mustache:*default-pathname-type* "html")) + (mustache:render template-path (append page-context *GLOBAL-CONTEXT*) + output-stream))))) + +(defun process-pages () + (format t "Processing pages..~%") + (generate-news) + (let ((template-path (pathname (merge-pathnames *LAYOUT-DIR* *DEFAULT-PAGE-TEMPLATE*)))) + (ensure-directories-exist *OUTPUT-DIR*) + (loop for page in *PAGES* + do + (format t "Generating ~A~%" (cdr (assoc :content page))) + (render-page page template-path)) + (format t "Done.~%"))) + +;; Process news + +(defparameter +edit-news-link+ "https://gitlab.common-lisp.net/clo/cl-site/edit/master/content/news.md") + +(defun generate-news () + (let ((html + (markdown:parse-file (merge-pathnames "news.md" *PAGES-DIR*)))) + (with-open-file (f (merge-pathnames "news.html" *PAGES-DIR*) + :direction :output + :if-does-not-exist :create + :if-exists :supersede) + (write-string "<div id=\"bodyText\">" f) + (format f "<a class=\"btn btn-secondary float-right\" href=\"~A\"><i class=\"far fa-edit\"></i> Edit this page</a>" +edit-news-link+) + (write-string "<h1>Latest Common-Lisp.net news</h1>" f) + (write-string html f) + (write-string "</div>" f)) + (with-open-file (f (merge-pathnames "newsbox.html" *PAGES-DIR*) + :direction :output + :if-does-not-exist :create + :if-exists :supersede) + (write-string (generate-news-box-content html) f)))) + +(defun shallow-copy-object (original) + (let* ((class (class-of original)) + (copy (allocate-instance class))) + (dolist (slot (mapcar #'c2mop:slot-definition-name (c2mop:class-slots class))) + (when (slot-boundp original slot) + (setf (slot-value copy slot) + (slot-value original slot)))) + copy)) + +(defun generate-news-box-content (html &key (count 5)) + (let ((dom (plump-parser:parse html))) + (let ((state :start) + (node (plump:first-child dom)) + (news (plump:make-root)) + (current-news)) + (block done + (flet ((next-node () + (setf node (plump:next-sibling node)) + (when (null node) + ;;(print "DONE") + (return-from done)) + node)) + (loop + ;;(print state) + ;;(print node) + (ecase state + (:start + (if (and (plump:element-p node) + (equalp (plump:tag-name node) "h3")) + (setf state :read-news-heading) + ;; else + (next-node))) + + (:read-news-heading + + ;; If enough news, exit + (when (= (length (plump:children news)) count) + (return-from done)) + + ;; Start a new one + (setf current-news + (plump:make-element news "section")) + + (let ((title-node (shallow-copy-object node))) + (setf (plump:tag-name title-node) "h7") + (plump:append-child current-news title-node)) + (next-node) + (setf state :read-news-content)) + + (:read-news-content + ;; We assume the node is a paragraph and we read its content + (if (and (plump:element-p node) + (equalp (plump:tag-name node) "p")) + (progn + (plump:append-child current-news (shallow-copy-object node)) + (next-node) + (setf state :start)) + ;; else + (next-node))))))) + (plump:serialize news nil))))