From e1e35efb951ac549d8668ed32923684570a826bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cristian=20Cezar=20Mois=C3=A9s?= <86272521+cristiancmoises@users.noreply.github.com> Date: Sat, 20 Apr 2024 03:14:37 +0000 Subject: [PATCH] Delete useful.scm --- useful.scm | 247 ----------------------------------------------------- 1 file changed, 247 deletions(-) delete mode 100644 useful.scm diff --git a/useful.scm b/useful.scm deleted file mode 100644 index 52dd94c..0000000 --- a/useful.scm +++ /dev/null @@ -1,247 +0,0 @@ -;;; -*- coding: utf-8 -*- -;;; -;;; This program is free software; you can redistribute it and/or -;;; modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 3 of the -;;; License, or (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see -;;; . - -(define-module (useful) - #:use-module (haunt html) - #:use-module (haunt reader) - #:use-module (haunt utils) - #:use-module (haunt asset) - #:use-module (haunt builder blog) - #:use-module (haunt page) - #:use-module (haunt post) - #:use-module (haunt site) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-19) - #:use-module (web uri) - #:use-module (ice-9 match) - #:use-module (sxml match) - #:use-module (sxml transform) - #:use-module (commonmark) - #:export (link* - default-theme - static-page - research-posts - projects-posts - centered-image - commonmark-reader* - date)) - -;;; HTML utilities --------------------------------------------------- - -(define (link* name uri) - "Create a link with NAME to url URI." - `("[" (a (@ (href ,uri)) ,name) "]")) - -(define (stylesheet name) - "Use the stylesheet NAME.css saved locally in css/." - `(link (@ (rel "stylesheet") - (href ,(string-append "/css/" name ".css"))))) - -(define (centered-image image) - "Create a centered image from source IMAGE." - `((div (@ (style "text-align: center")) (img (@ (src ,image)))))) - -;;; Post processing utilities ---------------------------------------- - -(define (date year month day) - "Create a SRFI-19 date for the given YEAR, MONTH, DAY" - (let ((tzoffset - (tm:gmtoff - (localtime (time-second (current-time)))))) - (make-date 0 0 0 0 day month year tzoffset))) - -(define (first-paragraph post) - "Extract the first paragraph from POST." - (let loop ((sxml (post-sxml post)) (result '())) - (match sxml - (() (reverse result)) - ((or (('p ...) _ ...) (paragraph _ ...)) - (reverse (cons paragraph result))) - ((head . tail) (loop tail (cons head result)))))) - -(define (contains? l m) - "Check if LIST contains MEMBER." - (if (null? l) - #f - (or (equal? (first l) m) - (contains? (drop l 1) m)))) - -(define (research? post) - "Check if POST has a research tag." - (contains? (post-ref post 'tags) "research")) - -(define (projects? post) - "Check if POST has a projects tag." - (contains? (post-ref post 'tags) "projects")) - -(define (research-posts posts) - "Returns POSTS that contain research tag in reverse chronological order." - (posts/reverse-chronological - (filter research? posts))) - -(define (projects-posts posts) - "Returns POSTS that contain projects tag in reverse chronological order." - (posts/reverse-chronological - (filter projects? posts))) - -;;; Links ------------------------------------------------------------ - -(define (github) - (link* "GitHub" "https://github.com/cristiancmoises")) - -(define (linkedin) - (link* "LinkedIn" "https://www.linkedin.com/in/cristiancezarmoises")) - -(define (orcid) - (link* "ResearchGate" "https://www.researchgate.net/profile/Cristian-Moises/research")) - -(define (arxiv) - (link* "TOR" "http://secopscj53y6qltbysxt2bhnr2ohwzi6bh6wbxonycgc6tdemj4xkmyd.onion/")) - -(define (ads) - (link* "Youtube" "https://youtube.com/@securityops")) - -(define (cc-by-sa) - (link* "CC BY-SA 4.0" "https://creativecommons.org/licenses/by-sa/4.0/")) - -;;; Website layout --------------------------------------------------- - -(define (header-box) - `(div (@ (id "block")) - (p "+>---------------------------<+") - (p ,(link* "About" "/about.html")-- - ,(link* "Research" "/research.html")-- - ,(link* "Projects" "/projects.html")) - (p "+>---------------------------<+") - (br))) - -(define (footer-box) - `(div (@ (id "block")) - (br) - (p "+>---------------------------<+") - (div ,(github)-- - ,(linkedin)) - (div ,(orcid)-- - ,(arxiv)-- - ,(ads)) - (p "© 2024 Cristian Cezar Moises") - (p ,(cc-by-sa)) - (p "Built with " - ,(link* "Haunt" "http://haunt.dthompson.us") - " in " - ,(link* "Scheme" "https://www.gnu.org/software/guile/guile.html")) - (p "+>---------------------------<+"))) - -(define default-theme - (theme #:name - "default-theme" - #:layout - (lambda (site title body) - `((doctype "html") - (head (meta (@ (charset "utf-8"))) - (meta (@ (name "description") - (content "C.C.M. personal website"))) - (meta (@ (name "viewport") - (content "width=device-width, initial-scale=1"))) - (title ,(string-append title " — " (site-title site))) - ,(stylesheet "default")) - (body (header ,(header-box)) - (div (@ (id "block")) ,body) - (footer ,(footer-box))))) - #:post-template - (lambda (post) - `((h1 ,(post-ref post 'title)) - (div ,(date->string (post-date post) "~B ~d, ~Y")) - (div ,(post-sxml post)))) - #:collection-template - (lambda (site title posts prefix) - (define (post-uri post) - (string-append - "/" - (or prefix "") - (site-post-slug site post) - ".html")) - `((h1 ,title) - ,(map (lambda (post) - (let ((uri (string-append - "/" - (site-post-slug site post) - ".html"))) - `(div (h2 (a (@ (href ,uri) - (style "text-decoration: none;")) - ,(post-ref post 'title))) - (div ,(date->string (post-date post) "~B ~d, ~Y")) - (div ,(first-paragraph post)) - ,(link* "read more..." uri) - (br) - (p (@ (style "text-align: center;")) "-->--<--")))) - posts))))) - -(define (static-page title file-name body) - "Create a static page with TITLE at html file FILENAME using page BODY." - (lambda (site posts) - (make-page - file-name - (with-layout default-theme site title body) - sxml->html))) - -;;; Custom markdown reader -------------------------------------------------- - -(define (sxml-identity . args) args) - -;; Code block -(define (code-block . tree) - (sxml-match - tree - ((pre (code ,source)) - `(div (@ (id "code")) - (pre (@ (style "overflow: auto")) (code ,source)))) - (,other other))) - -;; Convert hrefs to custom hoverable link -(define (hover-link . tree) - (sxml-match - tree - ((a (@ (href ,uri) unquote _) unquote name) - `(,(link* name uri))))) - -;; Center all images -(define (center-images . tree) - (sxml-match - tree - ((img (@ (src ,uri) unquote _)) - `(,(centered-image uri))))) - -(define %commonmark-rules - `((pre unquote code-block) - (a unquote hover-link) - (img unquote center-images) - (*text* unquote (lambda (tag str) str)) - (*default* unquote sxml-identity))) - -(define (post-process-commonmark sxml) - (pre-post-order sxml %commonmark-rules)) - -(define commonmark-reader* - (make-reader - (make-file-extension-matcher "md") - (lambda (file) - (call-with-input-file - file - (lambda (port) - (values - (read-metadata-headers port) - (post-process-commonmark (commonmark->sxml port))))))))