(defvar *default-navalpha* "/home/reuben/webpage/navalpha.menu") (defvar *default-navbeta* "/home/reuben/webpage/misc/navbeta.menu") (defun return-string-from-list(string-list) (string-concatenator-helper-function "" (flatten-list string-list))) (defun string-concatenator-helper-function (init-string string-list) (cond ((null string-list) init-string) (t (string-concatenator-helper-function (concatenate 'string init-string (car string-list)) (cdr string-list))))) (defun printattrs(parameters collector) (let ((current-args (car parameters))) (cond ((null parameters) collector) (t (printattrs (cdr parameters) (return-string-from-list (list collector (format nil " ~a" (car current-args)) " = " (format nil "'~a' " (car (cdr current-args)))))))))) (defun flatten-list(seq) (cond ((null seq) '()) ((not (consp seq)) (list seq)) (t (append (flatten-list (car seq)) (flatten-list (cdr seq)))))) (defmacro htmlmacro(name &optional single-tag) `(defun ,name(&rest parameters) (return-string-from-list (list "~&<" (format nil "~a" ,name) (if (consp (car parameters)) (printattrs (car parameters) "")) (if ,single-tag "/") ">~&" (if (not (consp (car parameters))) parameters (return-string-from-list (cdr parameters))) (if (not ,single-tag) (list "~&~&")))))) (defmacro gen-html(output-file html-list) `(with-open-file (output-stream ,output-file :direction :output :if-exists :supersede) (format output-stream ,html-list))) (defmacro gen-html1(output-file html-list) ` (format t ,html-list)) ;;;;;All macros defined now we do our tag specific stuff (defvar html (htmlmacro html)) (defvar body (htmlmacro body)) (defvar head (htmlmacro head)) (defvar title (htmlmacro title)) (defvar br (htmlmacro br t)) (defvar p (htmlmacro p)) (defvar a (htmlmacro a)) (defvar i (htmlmacro i)) (defvar b (htmlmacro b)) (defvar div (htmlmacro div)) (defvar h1 (htmlmacro h1)) (defvar h2 (htmlmacro h2)) (defvar code-tag (htmlmacro code-tag)) (defvar link (htmlmacro link t)) (defvar center (htmlmacro center)) (defvar img (htmlmacro img t)) (defun bold(text) (b text)) (defun insert-image(filename) (img '(("src" filename)))) (defun reference(link &optional text) (a (list (list 'href link)) (if (null text) link text))) (defun code(&rest code-listing) (concatenate 'string (br) (code-tag (return-string-from-list (flatten-list (mapcar #'(lambda(x) (list x "~&")) code-listing)))) (br))) (defun content(&rest content-list) (div '(("class" "content")) content-list)) (defun glossary-entry(term definition) (with-open-file (glossary-handle "glossary" :if-exists :supersede :direction :output) (format glossary-handle "~&~a|" term) (format glossary-handle "~&~a" definition) (format glossary-handle "~&~a" "<>"))) (defun glossary(glossary-text) (reference (concatenate 'string "glossary.html#" glossary-text) glossary-text)) (defun page(&rest page-contents) (html (head (title "Reuben's Webpage") (link '(("rel" "stylesheet") ("href" "sitestyle.css") ("type" "text/css")))) (body (if (listp page-contents) (return-string-from-list (mapcar #'(lambda(x) (eval x)) page-contents)) page-contents)))) (defun pagetitle(title-text) (div '(("id" "header")) (center (h1 title-text)))) (defun generate-menu(menuitems) (cond ((null menuitems) "") (t (concatenate 'string (reference (second (car menuitems)) (first (car menuitems))) (br)(br) (generate-menu (cdr menuitems)))))) (defun navalpha(&rest menuitems) (div '(("id" "navAlpha")) (generate-menu menuitems))) (defun navbeta (&rest menuitems) (div '(("id" "navBeta")) (generate-menu menuitems))) (defun include-navbeta(&optional navbeta-file) (with-open-file (in (concatenate 'string (extensions:unix-namestring (extensions:default-directory)) "navbeta.menu")) (if (null in) "FILE NOT FOUND" (eval (read in))))) (defun include-navalpha(&optional navalpha-file) (with-open-file (in (if (null navalpha-file) *default-navalpha* navalpha-file) :if-does-not-exist nil) (if (equal in nil) "NAVALPHA file does not exist" (eval (read in))))) ;HTML elements with attributes are called as follows ;(a '((href "test")) "test") ; +-------------+ ; | ; This is how the argument should be passed (defun main(command-line-args) (defun command-loop(args) (cond ((null args) t) (t (let ((arg (car args))) ;Check if the extension is page...then we have a file (if (string= "page" (subseq arg (- (length arg) 4) (length arg))) (let ((filename arg)) (with-open-file (in filename) (eval (read in))) (command-loop (cdr args))) (command-loop (cdr args))))))) (command-loop command-line-args)) (main extensions:*command-line-strings*) (quit)