Plaster
New
List
Login
text
apl
aspx
asterisk
brainfuck
c
c++hdr
c++src
cassandra
ceylon
clojure
clojurescript
cmake
cobol
coffeescript
common-lisp
crystal
csharp
css
cypher-query
cython
d
dart
diff
django
dockerfile
dylan
ebnf
ecl
ecmascript
edn
eiffel
ejs
elm
erb
erlang
ez80
factor
fcl
feature
forth
fortran
fragment
gfm
go
gql
groovy
gss
haml
handlebars-template
haskell
haxe
hive
html
http
httpd-php
httpd-php-open
hxml
ini
java
javascript
json
jsp
jsx
julia
kotlin
latex
less
literate-haskell
lua
mariadb
markdown
mbox
mirc
mscgen
msgenny
mssql
mumps
mysql
n-triples
nesc
nginx-conf
nsis
objectivec
octave
oz
pascal
perl
pgp
pgp-keys
pgp-signature
pgsql
php
pig
plsql
properties
protobuf
puppet
python
q
rpm-changes
rpm-spec
rsrc
ruby
rustsrc
sas
sass
scala
scheme
scss
sieve
slim
smarty
solr
soy
sparql-query
spreadsheet
sql
squirrel
stex
styl
swift
systemverilog
tcl
textile
tiddlywiki
tiki
tlv
tornado
ttcn-asn
ttcn-cfg
turtle
twig
typescript
typescript-jsx
vb
vbscript
velocity
verilog
vertex
vhdl
vue
webidl
xml
xml-dtd
xquery
xu
yaml
z80
default
Visibility:
public
unlisted
private
(defun car-when-available (entry) "evals to the car of an entry if that entry is a list if not it will just eval the entry itself" (etypecase entry (list (car entry)) (t entry))) (defun get-car-of-list-of-lists (list) "Takes in an list like ((a 1) b c) and evals to (a b c)." (mapcar #'car-when-available list)) (defun generate-keys-arg (list &optional (default-val t)) "Takes in a list like an alist or a list like '(home login users register) and outputs '(&key (home t) (login t) (users t) (register t))" (append (list '&key) (mapcar (lambda (entry) (list entry default-val)) (get-car-of-list-of-lists list)))) (defun symbol-to-downcase-str (symbol) "Returns a downcase string of symbol eg home becomes 'home'" (string-downcase (symbol-name symbol))) (defun append-c-to-symbol (c symbol) "appends c to a symbol eg (append-c-to-symbol '/' 'home) '/home'" (let ((name (symbol-to-downcase-str symbol))) (concatenate 'string c name))) (defun gen-url-from-symbol (symbol) "concatenates '/' to the start of symbol and returns as a string" (append-c-to-symbol "/" symbol)) (defun capitalize-nth-char (string n) "Capitalizes nth character in string eg (capitalize-nth-char 'abcdef' 2) -> 'aBcdef'" (string-upcase string :start (1- n) :end n)) (defun capitalize-1st-char (string) (capitalize-nth-char string 1)) (defun generate-navigation-html (entry) "Generates the code that would when evaluated become an entry for a navigation bar. can take in two types of argument a symbol alone like home which would eval to (HOME () (WHEN HOME (WITH-HTML (:LI :CLASS \"navigation-item\" (:A :CLASS \"navigation-link\" :HREF \"/home\" :DATA-POPOVER \"\" \"Home\") or (home '/') the second argument being a specific url, this function will no longer generate a url automatically but will use that instead producing a result like: (HOME () (WHEN HOME (WITH-HTML (:LI :CLASS \"navigation-item\" (:A :CLASS \"navigation-link\" :HREF \"/\" :DATA-POPOVER \"\" NIL)" (let ((href nil) (ent nil)) (etypecase entry (list (setf href (second entry) ent (capitalize-1st-char (symbol-to-downcase-str (first entry))) entry (first entry))) (symbol (setf href (gen-url-from-symbol entry) ent (capitalize-1st-char (symbol-to-downcase-str entry)))) (t (setf entry "ERROR" href "ERROR"))) `(,entry nil (when ,entry (with-html (:li :class "navigation-item" (:a :class "navigation-link" :href ,href :data-popover "" ,ent))))))) (defun generate-navigations-html (entries) "Does the same as (generate-navigation-html entry) but for a list of entries" (mapcar #'generate-navigation-html entries)) (defmacro generate-navigation-bar (list-of-entries) `(defun navigation-bar ,(generate-keys-arg list-of-entries) (flet ,(generate-navigations-html list-of-entries) (with-html (:nav :class "navigation" (:section :class "container" (:a :class "navigation-title" :href "/" (:img :class "img" :src ,(website-standard-image) :height "15") (:h1 :class "title" ,(website-title))) ,(append `(:ul :class "navigation-list float-right" ,@(mapcar (lambda (entry) (list entry)) (get-car-of-list-of-lists list-of-entries))))))))))