diff options
| -rw-r--r-- | .gitignore | 6 | ||||
| -rw-r--r-- | files/bandleader.py | 271 | ||||
| -rw-r--r-- | files/conway.cpp | 95 | ||||
| -rw-r--r-- | files/fussy.lisp | 608 |
4 files changed, 976 insertions, 4 deletions
@@ -1,6 +1,4 @@ *~ *svg -files/* -files/*/* -files/*/*/* -files/*/*/*/*
\ No newline at end of file +files/themes/* +files/store/* diff --git a/files/bandleader.py b/files/bandleader.py new file mode 100644 index 0000000..16e167d --- /dev/null +++ b/files/bandleader.py @@ -0,0 +1,271 @@ +from selenium.webdriver import Firefox +from selenium.webdriver.firefox.options import Options +from collections import namedtuple, Counter +from threading import Thread +from time import sleep, ctime +from os.path import isfile +import csv + + +BANDCAMP_FRONTPAGE='https://bandcamp.com/' + +TrackRec = namedtuple('TrackRec', + ['track_url', # if available + 'title', + 'artist', + 'artist_url', + 'album', + 'album_url', + 'timestamp' # when you played it + ]) + +class BandLeader(): + + def __init__(self,csvpath=None): + + self.database_path=csvpath + self.database = [] # using a list b/c its simple + + # load database from disk if possible + if isfile(self.database_path): + with open(self.database_path, newline='') as dbfile: + dbreader = csv.reader(dbfile) + next(dbreader) # to ignore the header line + self.database = [TrackRec._make(rec) for rec in dbreader] + + # create a headless browser + opts = Options() + opts.set_headless() + self.browser = Firefox(options=opts) + self.browser.get(BANDCAMP_FRONTPAGE) + self.paused = True + + self.autoplay_on = False + self._current_track_record = None + self._current_track_number = 1 + # create a thread that periodically maintains our database by + # consulting the browser's current state + self._has_quit = False + self.thread = Thread(target=self._maintain) + self.thread.daemon = True # kills the thread when the main process dies + self.thread.start() + + self.tracks() + + def _maintain(self): + while not self._has_quit: + self._update_db() + self._check_auto_advance() + sleep(1) + + + def log(self,where, err): + print(where, err) + + + def save_db(self): + with open(self.database_path,'w',newline='') as dbfile: + dbwriter = csv.writer(dbfile) + dbwriter.writerow(list(TrackRec._fields)) + for entry in self.database: + dbwriter.writerow(list(entry)) + + + def _update_db(self): + try: + check = (self._current_track_record is not None + and self._current_track_record is not None + and (len(self.database) == 0 + or self.database[-1] != self._current_track_record) + and self.is_playing()) + if check: + self.database.append(self._current_track_record) + self.save_db() + + except Exception as e: + self.log('_update_db',e) + + + def _check_auto_advance(self): + try: + if self.autoplay_on and not self.is_playing(): + self.play_next() + except Exception as e: + self.log('_check_auto_advance', e) + + + def toggle_autoplay(self): + self.autoplay_on = not self.autoplay_on + if self.autoplay_on: + print('autoplay is ON') + else: + print('autoplay is OFF') + + + def currently_playing(self): + ''' + returns the record for the currently playing track, + or None if nothing is playing + ''' + try: + if self.is_playing(): + track_title = self.browser.find_element_by_class_name('title').text + album_detail = self.browser.find_element_by_css_selector('.detail-album > a') + album_title = album_detail.text + album_url = album_detail.get_attribute('href').split('?')[0] + artist_detail = self.browser.find_element_by_css_selector('.detail-artist > a') + artist = artist_detail.text + artist_url = artist_detail.get_attribute('href').split('?')[0] + return TrackRec('',track_title,artist,artist_url,album_title,album_url,ctime()) + except Exception as e: + print('there was an error: {}'.format(e)) + + return None + + + def tracks(self): + ''' + lists the tracks that are presently available for play and + associates a track number with each one. You may use these + track numbers to as arguments to the `play` method. + ''' + sleep(1) + discover_section = self.browser.find_element_by_class_name('discover-results') + left_x = discover_section.location['x'] + right_x = left_x + discover_section.size['width'] + + discover_items = self.browser.find_elements_by_class_name('discover-item') + self.track_list = [t for t in discover_items + if t.location['x'] >= left_x and t.location['x'] < right_x] + + for (i,track) in enumerate(self.track_list): + print('[{}]'.format(i+1)) + lines = track.text.split('\n') + print('Album : {}'.format(lines[0])) + print('Artist : {}'.format(lines[1])) + if len(lines) > 2: + print('Genre : {}'.format(lines[2])) + + + def play(self,track=None): + ''' + plays a track. If `track` is not supplied, this method + simulates pressing the play button somewhere on bandcamp's site. + + If `track` is an `int`, this method plays the track with that + track number. See the `tracks` method. + ''' + + if track is None: + self.browser.find_element_by_class_name('playbutton').click() + elif type(track) is int and track <= len(self.track_list) and track >= 1: + self._current_track_number = track + self.track_list[self._current_track_number - 1].click() + + sleep(0.5) + if self.is_playing(): + self._current_track_record = self.currently_playing() + print("CURRENTLY PLAYING") + self.print_track() + + def pause(self): + self.play() + self.paused = True + + + def resume(self): + if self.paused: + self.play() + self.paused = False + + + def is_playing(self): + ''' + returns `True` if a track is presently playing + ''' + playbtn = self.browser.find_element_by_class_name('playbutton') + return playbtn.get_attribute('class').find('playing') > -1 + + + def play_next(self): + ''' + plays the next available track + ''' + if self._current_track_number < len(self.track_list): + self.play(self._current_track_number+1) + else: + self.more_tracks() + self.play(1) + + + def play_prev(self): + ''' + plays the previous available track + ''' + if (self._current_track_number - 1) >= 0: + self.play(self._current_track_number -1) + + + def top_tracks(self,num=10): + ''' + lists the top `num` tracks in order of frequency of listening + ''' + c = Counter(t.title for t in self.database) + return c.most_common(num) + + def top_albums(self,num=10): + c = Counter(t.album for t in self.database) + return c.most_common(num) + + def top_artists(self,num=10): + c = Counter(t.artist for t in self.database) + return c.most_common(num) + + def catalogue_pages(self): + ''' + print the available pages in the catalogue that are presently + accessible + ''' + print('PAGES') + for e in self.browser.find_elements_by_class_name('item-page'): + print(e.text) + print('') + + + def more_tracks(self,page='next'): + ''' + finds more tracks in a contextual way. + + If on the main page, advances the listing in the 'Discover' + section. + + If on an album page, looks to the next album in the + 'Discography' section for the present artist. + ''' + next_btn = [e for e in self.browser.find_elements_by_class_name('item-page') + if e.text.lower().strip() == str(page)] + + if next_btn: + next_btn[0].click() + self.tracks() + + def explore(self): + ''' + visits the start page and lists tracks + ''' + self.browser.get(BANDCAMP_FRONTPAGE) + self.tracks() + + + def quit(self): + self._has_quit = True + self.browser.close() + # flush db to disk + + def print_track(self,tr=None): + if tr is None: + tr = self._current_track_record + + if tr is not None: + print('{}\n by {}\n on the album {}'.format(tr.title,tr.artist,tr.album)) + diff --git a/files/conway.cpp b/files/conway.cpp new file mode 100644 index 0000000..1e60014 --- /dev/null +++ b/files/conway.cpp @@ -0,0 +1,95 @@ +/* ======================================================================= */ +/* CONWAY.CPP */ +/* ======================================================================= */ + +#include "assert.h" +#include "iostream.h" +#include "conio.h" +#include "clheir.h" +#include "screen.h" +#include "conway.h" + +#define max(x,y) ((x > y) ? x : y) +#define min(x,y) ((x > y) ? y : x) + +const int num_rows = min(50, NUM_ROWS); +const int num_columns = 40; + +class site *field_of_play[num_rows][num_columns]; + +int site::total_surrounding(void) + { + int i, j, imin, imax, jmin, jmax, total; + + total = 0; + imin = max(0, x - 1); + imax = min(num_rows - 1, x + 1); + jmin = max(0, y - 1); + jmax = min(num_columns - 1, y + 1); + + for (i = imin; i <= imax; i++) + for (j = jmin; j <= jmax; j++) + if (field_of_play[i][j]->read()) total++; + if (alive) total--; + return total; + } + +void display(void) + { + int i, j; + + for (i = 0; i < num_rows; i++) + for (j = 0; j < num_columns; j++) + { + if (field_of_play[i][j]->read()) write_xyc(2*j, i, 'X'); + else write_xyc(2*j, i, '.'); + } + hide_cursor(); + } + +void glider(int x, int y) + { + field_of_play[x - 1][y + 0]->set(); + field_of_play[x - 1][y + 1]->set(); + field_of_play[x + 0][y - 1]->set(); + field_of_play[x + 0][y + 0]->set(); + field_of_play[x + 1][y + 1]->set(); + } + +void traffic_light(int x, int y) + { + field_of_play[x - 1][y]->set(); + field_of_play[x + 0][y]->set(); + field_of_play[x + 1][y]->set(); + } + + +void main(void) + { + int i, j, c; + + init_registry(); + + for (i = 0; i < num_rows; i++) + for (j = 0; j < num_columns; j++) + field_of_play[i][j] = new site(i, j); + +start_over: + traffic_light(num_rows/2 - 8, num_columns/2 - 8); + glider(num_rows/2 + 8, num_columns/2 + 8); + + clear_screen(); + while (1) + { + display(); + if ((c = getch()) == 'q') { clear_screen(); return; } + if (c == 'i') + { + for (i = 0; i < num_rows; i++) + for (j = 0; j < num_columns; j++) + field_of_play[i][j]->clear(); + goto start_over; + } + step_everybody(); + } + } diff --git a/files/fussy.lisp b/files/fussy.lisp new file mode 100644 index 0000000..c7c8f84 --- /dev/null +++ b/files/fussy.lisp @@ -0,0 +1,608 @@ +;;;; fussy.lisp + +(in-package #:fussy) +(defvar +default-emacs-package-archive+ + "https://melpa.org/packages/archive-contents") + +(defun emacs-reader-readtable () + "Return a readtable that will read the emacs package archive +contents." + (let ((*readtable* (copy-readtable nil))) + (labels ((bracket-reader (stream char) + (declare (ignorable char)) + (read-delimited-list #\] stream))) + (set-macro-character #\[ #'bracket-reader) + (set-macro-character #\] (get-macro-character #\) nil)) + *readtable*))) + +(defun fetch-emacs-archive (&optional (archive +default-emacs-package-archive+)) + "Fetch the package archive from ARCHIVE, a url, and read it in using +the emacs' reader readtable." + ;; TODO: HANDLE HTTP ERRORS, HANDLE TIMEOUT, HANDLE READ ERRORS + (multiple-value-bind (stream status) (dexador:get archive :want-stream t) + (when (= 200 status) + (let* ((*package* (find-package :fussy)) + (*readtable* (emacs-reader-readtable))) + (read stream))))) + +(defclass/std theme-pkg (db:store-object) + ((name + :with + :index-type bknr.indices:unique-index + :index-reader theme-pkg-with-name) + (commit + version + authors + maintainer + keywords + url + description + contained-themes + :with)) + (:metaclass db:persistent-class) + (:documentation "Represents an Emacs theme package.")) + +(defmethod print-object ((theme theme-pkg) stream) + (format stream "#<THEME-PKG ~a ~a>" + (theme-pkg-name theme) + (theme-pkg-version theme))) + +(defparameter +excludes+ + '(tramp-theme color-theme airline-themes unobtrusive-magit-theme cycle-themes )) + +(defun theme-package-p (archive-object) + (when (consp archive-object) + (unless (member (first archive-object) +excludes+) + (let ((name + (symbol-name (first archive-object)))) + (or (a:ends-with-subseq "-theme" name :test #'char-equal) + (a:ends-with-subseq "-themes" name :test #'char-equal)))))) + +(defun archive-theme-name (archive-pkg) + (first archive-pkg)) + +(defun archive-theme-version (archive-pkg) + (second archive-pkg)) + +(defun make-theme-pkg-from-archive-theme (archive-theme) + (destructuring-bind (name version _dontcare desc _dontcare2 meta-alist) archive-theme + (declare (ignore _dontcare _dontcare2)) + (db:with-transaction () + (make-instance + 'theme-pkg + :name name + :version version + :description desc + :commit (cdr (assoc :commit meta-alist)) + :maintainer (cdr (assoc :maintainer meta-alist)) + :url (cdr (assoc :url meta-alist)) + :authors (cdr (assoc :authors meta-alist)) + :keywords (cdr (assoc :keywords meta-alist)))))) + +(defun update-theme-pkg-from-archive-theme (pkg arch) + (destructuring-bind (name version _dontcare desc _dontcare2 meta-alist) arch + (declare (ignore _dontcare _dontcare2)) + (db:with-transaction () + (setf + (theme-pkg-name pkg) name + (theme-pkg-version pkg) version + (theme-pkg-description pkg) desc + (theme-pkg-commit pkg) (cdr (assoc :commit meta-alist)) + (theme-pkg-maintainer pkg) (cdr (assoc :maintainer meta-alist)) + (theme-pkg-url pkg) (cdr (assoc :url meta-alist)) + (theme-pkg-authors pkg) (cdr (assoc :authors meta-alist)) + (theme-pkg-keywords pkg) (cdr (assoc :keywords meta-alist)))))) + + +(defun process-archive-theme (archive-theme) + ;; ugg this is ugly. I hate it when code is all dense like this. + (a:if-let (pkg + (theme-pkg-with-name + (archive-theme-name archive-theme))) + (when (not (equalp (archive-theme-version archive-theme) + (theme-pkg-version pkg))) + (update-theme-pkg-from-archive-theme pkg archive-theme)) + (make-theme-pkg-from-archive-theme archive-theme))) + +(defun theme-needs-update-p (archive-theme) + "A theme should be updated if eithe it is new or if its version +differs from the theme-pkg instance already in the data store." + (let ((pkg + (theme-pkg-with-name + (archive-theme-name archive-theme)))) + (not + (and pkg + (equalp (archive-theme-version archive-theme) + (theme-pkg-version pkg)))))) + +(defun update-theme-packages () + (let ((themes-to-update + (remove-if-not + (a:conjoin #'theme-package-p #'theme-needs-update-p) + (fetch-emacs-archive)))) + ;; just going to let this throw an error. will either introduce a + ;; restart-case with some restarts or something later, or will + ;; just catch the error in the caller of update-theme-packages + (when themes-to-update + ;; delete the temporary .emacs.d + (uiop:delete-directory-tree + (uiop:merge-pathnames* ".emacs.d/" (full-theme-image-directory)) + :validate t + :if-does-not-exist :ignore) + + (generate-images-for-packages + (mapcar #'archive-theme-name themes-to-update)) + + ;; if we didn't error: update the db + (dolist (archive-theme themes-to-update) + (process-archive-theme archive-theme)) + + (reindex-themes-by-package)))) + +(defun all-theme-keywords () + (delete-duplicates + (copy-seq (mapcan (a:compose #'copy-seq #'theme-pkg-keywords) + (db:store-objects-with-class 'theme-pkg))) + :test #'equal)) + +(defun themes-with-keywords (&rest keywords) + (loop :for theme :in (db:store-objects-with-class 'theme-pkg) + :when (subsetp keywords (theme-pkg-keywords theme) + :test #'string-equal) + :collect theme)) + +(defun all-theme-packages () + (db:store-objects-with-class 'theme-pkg)) + +(defun just-the-directory-namestring (path) + "returns a string, the name of the directory that the path represents." + ;; directory-namestring is taken, seems to peel off any file at the end + (first (last (pathname-directory path)))) + +(defun themes-in-package (pkg &optional (config *config*)) + "Themes that belong to a particular package are stored as the names of +directories that contain the theme's images. These directories are +stored beneath the directory that names the package. This function +returns a list of those names." + (mapcar #'just-the-directory-namestring + (uiop:subdirectories + (uiop:merge-pathnames* + (string-downcase (format nil "~a/" (theme-pkg-name pkg))) + (full-theme-image-directory config))))) + +(defun all-themes () + (a:mappend #'themes-in-package (all-theme-packages))) + +(defun theme-mentions-anywhere (term) + (lambda (theme) + (or (search term theme) + (with-slots (name keywords description authors maintainer) (theme-package theme) + (or (search term (symbol-name name) :test #'char-equal) + (search term description :test #'char-equal)))))) + +(defun search-themes (&rest terms) + (remove-if-not + (apply #'a:conjoin (mapcar #'theme-mentions-anywhere terms)) + (all-themes))) + +(defvar *theme->packages* nil + "A hash table indexing packages by the themes they contain.") + +(defun theme-package (theme) (gethash theme *theme->packages*)) + +(defun reindex-themes-by-package () + (let ((table (make-hash-table :test #'equal))) + (dolist (pkg (all-theme-packages)) + (dolist (theme (themes-in-package pkg)) + (setf (gethash theme table) pkg))) + (setf *theme->packages* table))) + +(defgeneric url-path (theme)) +(defmethod url-path ((theme theme-pkg)) + (format nil "/package/~a" (string-downcase (theme-pkg-name theme)))) +(defmethod url-path ((theme string)) + (assert (theme-p theme)) + (format nil "/theme/~a/~a" + (string-downcase (theme-pkg-name (theme-package theme))) + theme)) + +(defun theme-p (string) (not (null (theme-package string))) ) + +(defclass/std config () + ((theme-image-directory + store-directory + fussy-el + :std "" + :documentation "These paths are by default equal to the config directory.") + (port :std 8888) + (domain :std "localhost") + (address :std "0.0.0.0"))) + + +(defvar *config* nil) +(defvar *config-directory* nil + "The config dir is the directory where the config file is. This +directory is used as a default directory for all relative paths +mentioned in the config file. Any Absolute paths in the config file +are treated as such.") + +(defun load-config-from-file (file) + (apply #'make-instance + 'config + (read-from-string (a:read-file-into-string file)))) + +(defun full-store-directory (&optional (config *config*)) + (uiop:merge-pathnames* (store-directory config) *config-directory*)) + +(defun full-theme-image-directory (&optional (config *config*)) + (uiop:merge-pathnames* (theme-image-directory config) *config-directory*)) + +(defun emacs-dot-d-directory (&optional (config *config*)) + (uiop:merge-pathnames* ".emacs.d/" (full-theme-image-directory config))) + +(defun create-db () + (unless (boundp 'db:*store* ) + (ensure-directories-exist (full-store-directory)) + (make-instance + 'db:mp-store + :directory (full-store-directory) + :subsystems (list (make-instance 'db:store-object-subsystem))))) + + + + +(defparameter +standard-themes+ + '(adwaita deeper-blue dichromacy light-blue modus-operandi modus-vivendi tango-dark + wheatgrass manoj-dark tsdh-dark tsdh-light whiteboard + leuven misterioso tango wombat) + "these are built in themes - this list can be passed to the image +generation script when you want to generate themes for just a single +package - ordinarily the script generates images for all themes, but +passing this list as the value of FUSSY-EXCLUDED-THEMES will ensure +that they are not loaded during image gen.") + + +(defun generate-elisp-to-fetch-and-exclude (package-names) + (let ((downcaser + (a:compose #'string-downcase #'symbol-name))) + (format nil "(setq fussy-themes-packages '(~{~a~^ ~}) fussy-excluded-themes '(~{~a~^ ~}))" + (mapcar downcaser package-names) + (mapcar downcaser +standard-themes+)))) + +(defun fussy-elisp-script-location (&optional (config *config*)) + (uiop:merge-pathnames* *config-directory* (fussy-el config))) + +(defun format-emacs-evocation-script (package-names) + (format + nil + "env HOME=~a emacs -q --eval ~s --load ~a" + (full-theme-image-directory) + (generate-elisp-to-fetch-and-exclude package-names) + (fussy-elisp-script-location))) + + +(defun generate-images-for-packages (package-names) + (when package-names + (uiop:run-program + (format-emacs-evocation-script package-names)))) + +(defvar *server* nil) + +(defun image-files-for-theme (theme) + (uiop:directory-files + (format nil "~a/~a/~a/" + (full-theme-image-directory) + (string-downcase (theme-pkg-name (theme-package theme))) + theme))) + +(defun theme-preview-image-path (theme &optional variant) + (assert (theme-p theme)) + (format nil "/images/~a/~a/~a.svg" + (string-downcase (theme-pkg-name (theme-package theme))) + theme + (or variant (pathname-name (first (image-files-for-theme theme)))))) + + +(defun start (&key config-file) + (unless config-file + (setf config-file + (or (uiop:getenv "FUSSY_CONFIG") + (asdf:system-relative-pathname :fussy "config.sexp")))) + (print config-file) + (unless *config* + (setf *config* + (load-config-from-file config-file) + *config-directory* + (uiop:pathname-directory-pathname config-file))) + (unless *server* + (setf *server* + (lzb:create-server + :port (port *config*) + :address (address *config*) + :domain (domain *config*)))) + (create-db) + (update-theme-packages) + (lzb:install-app *server* (lzb:app)) + (lzb:start-server *server*)) + +(lzb:provision-app () + :title "Emacs Themes Library" + :content-type "text/html") + +;;; pages + +(defun an-integer (string) + (parse-integer string)) + + +(defparameter +themes-per-page+ 20) + +(defun nav () + (html:with-html + (:nav + (:a :href "/" (:h1 "FUSSY"))))) + +(defun page-nav (page page-count &optional terms) + "relative pagination nav to current page." + (flet ((format-string (pg) + (if terms + (format nil "?page=~a&terms=~{~a~^+~}" pg terms) + (format nil "?page=~a" pg)))) + (html:with-html + (:div :class "bigger center" + (:span (when (plusp page) + (:a :href (format-string (1- page)) " <<--- ")) + " | " + (when (< page (1- page-count)) + (:a :href (format-string (1+ page)) " --->> ")))) + (:div + :class "page-nav" + (dotimes (pg page-count) + (if (= pg page) + (:span (format nil " ~a " (1+ pg))) + (:span " " + (:a :href (format-string pg) (format nil "~a" (1+ pg))) + " "))))))) + +(defun theme-preview-image (theme &optional variant) + (html:with-html + (:img + :src (theme-preview-image-path theme variant)))) + +(defun theme-preview-card (theme) + (html:with-html + (:div :class "card" + (:a :href (url-path theme) (:h4 theme) + (theme-preview-image theme))))) + +(defun style () + (html:with-html + (:link :rel "stylesheet" :type "text/css" :href "/css/style.css"))) + +(defparameter +css-reset+ + " +html { + box-sizing: border-box; + font-size: 16px; +} + +*, *:before, *:after { + box-sizing: inherit; +} + +body, h1, h2, h3, h4, h5, h6, p, ol, ul { + margin: 0; + padding: 0; + font-weight: normal; +} + +ol, ul { + list-style: none; +} + +img { + max-width: 100%; + height: auto; +} + +") + + +(defparameter +style-css+ + " +html, body { + height: 100%; +} + +.main { + height: 100%; + width: 100%; + background-color: #eeeeff; +} + +.container { + width: 100%; + display: flex; + flex-wrap: wrap; + justify-content: space-evenly; +} + +.card { + min-width: 500px; + max-width: 50%; +} + +.card > a > h4 { + color: green; + text-align: center; +} + +.bigger { + font-size: 1.25em; +} + +.center { + text-align: center; +} + +.search { + margin-left: auto; + margin-right: auto; + width: 300px; +} + +h1 { + text-align: center; +} + +.header { + padding-top: 20px; + padding-bottom: 20px; + margin-top: 20px; + margin-bottom: 40px; +} + +.page-nav { + text-align: center; + font-size: 1.3em; + margin-top: 10px; + margin-bottom: 20px; +} + + +") + +(lzb:defendpoint* :get "/css/style.css" () () + "Endpoint generating and serving main css" + (setf (lzb:response-header :content-type) "text/css") + (concatenate 'string + +css-reset+ + '(#\newline) + +style-css+)) + +(lzb:defendpoint* :get "/images/:pkg:/:theme:/:image:" () () + "Endpoint for serving theme preview images" + (let ((file-path + (pathname + (format nil "~a/~a/~a/~a" + (full-theme-image-directory) + pkg + theme + image)))) + (unless (uiop:file-exists-p file-path) + (lzb:http-err 404 "no such file")) + file-path)) + +(defun a-string (s) s) + +(lzb:defendpoint* :get "/" ((page an-integer) (terms a-string)) () + "The landing page" + (let* ((page + (or page 0)) + (terms + (when terms (str:split-omit-nulls #\space terms))) + (all-themes + (if terms + (apply #'search-themes terms) + (all-themes))) + (page-count + (ceiling (/ (length all-themes) +themes-per-page+))) + (themes + (a:subseq* all-themes + (* page +themes-per-page+) + (* (1+ page) +themes-per-page+)))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title "Fussy - Emacs Themes Gallery") + (style)) + (:body + (:div :class "main" + (nav) + (:div :class "center header" + (:p + "Emacs Themes Gallery for your Daily Procrastination Needs." (:br) + (write-to-string (length all-themes)) " themes and counting...")) + (:div :class "search" + (:form :method "GET" :action "/" + (:label :for "terms") + (:input :name "terms" :value (format nil "~{~a ~}" terms)) + (:button :type "submit" "search"))) + (when (< 1 page-count) + (page-nav page page-count terms)) + (:div :class "container" + (dolist (theme themes) + (theme-preview-card theme))) + (:div :class "foooter" + (when (< 1 page-count) + (page-nav page page-count terms))))))))) + +(defun a-package (string) + (a:if-let (pkg + (theme-pkg-with-name + (intern (string-upcase string) :fussy))) + pkg + (lzb:http-err 404 (format nil "No such theme package: ~a" string)))) + +(defun a-theme (string) + (if (theme-p string) string + (lzb:http-err 404 (format nil "No such theme: ~a" string)))) + +(defun package-namestring (pkg) + (hq:>> () pkg theme-pkg-name symbol-name string-downcase)) + +(lzb:defendpoint* :get "/package/:pkg a-package:" ((page an-integer)) () + "The page endpoint for a theme package" + (let ((themes + (themes-in-package pkg)) + (page + (or page 0))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title ) + (style)) + (:body + (:div :class "main" + (nav) + (:div :class "center header" + (:h2 (package-namestring pkg) ) + (:p (theme-pkg-description pkg)) + (:p "This package contains" + (length themes) + (if (= 1 (length themes)) " theme" " themes")) + (:p (:a :href (theme-pkg-url pkg) + (theme-pkg-url pkg)))) + (when (< +themes-per-page+ (length themes)) + (page-nav page (floor (/ (length themes) +themes-per-page+)))) + (:div :class "container" + (dolist (theme (a:subseq* themes + (* page +themes-per-page+) + (* (1+ page) +themes-per-page+))) + (theme-preview-card theme))) + (when (< +themes-per-page+ (length themes)) + (page-nav page (floor (/ (length themes) +themes-per-page+)))))))))) + +(lzb:defendpoint* :get "/theme/:pkg a-package:/:theme a-theme:" () () + "The page for a particular theme showing its previews for different prog langs" + (unless (member theme (themes-in-package pkg) :test #'string-equal) + (lzb:http-err 403 (format nil "The theme ~a is not in the package ~a" + theme (package-namestring pkg)))) + (html:with-html-string + (:doctype) + (:html + (:head + (:title theme) + (style)) + (:body + (:div :class "main" + (nav) + (:div :class "center header" + (:h2 theme) + (:p "A theme in the package " + (:a :href (url-path pkg) (package-namestring pkg)))) + (:div :class "container" + (dolist (variant (mapcar #'pathname-name (image-files-for-theme theme))) + (theme-preview-image theme variant)))))))) |