(require 'elnode) (require 'esxml) (require 'cl-lib) (defvar eliss-data-directory "~/projects/eliss/projects") (defun project-row (project) (let ((pname (substring project 0 -4))) `(tr (td (a (@ (href ,(concat "/" pname "/"))) ,pname))))) (defun eliss-page (title &rest body) (concat "" (sxml-to-xml `(html (head (link (@ (href "http://ryuslash.org/bootstrap2/css/bootstrap.min.css") (type "text/css") (rel "stylesheet"))) (title ,title)) (body (div (@ (class "navbar navbar-static-top")) (div (@ (class "navbar-inner")) (div (@ (class "container")) (a (@ (href "/") (class "brand")) ,title)))) (div (@ (class "container")) ,@body)))))) (defun eliss-project-list (httpcon) (elnode-http-start httpcon 200 '("Content-Type" . "text/html")) (elnode-http-return httpcon (eliss-page "project list" `(table (@ (class "table")) ,@(mapcar #'project-row (directory-files eliss-data-directory nil "\\.org$")))))) (defun eliss-control-group (name label &optional placeholder default) `(div (@ (class "control-group")) (label (@ (class "control-label") (for ,name)) ,label) (div (@ (class "controls")) (input (@ (type "text") (name ,name) (id ,name) ,(if placeholder `(placeholder ,placeholder) nil) ,(if default `(value ,default) nil)))))) (defun eliss-project-page (httpcon) (let* ((project (match-string 1 (elnode-http-mapping httpcon))) (filename (concat eliss-data-directory "/" project ".org")) (buffer (find-file-noselect filename))) (elnode-http-start httpcon 200 '("Content-Type" . "text/html")) (elnode-http-return httpcon (eliss-page project `(table (@ (class "table")) ,@(with-current-buffer buffer (org-map-entries (lambda () `(tr (td ,(org-entry-get (point) "TODO")) (td ,(org-entry-get (point) "CATEGORY")) (td (a (@ (href ,(concat "/" project "/" (org-id-get) "/"))) ,(nth 4 (org-heading-components)))) (td ,(org-entry-get (point) "TAGS")))) nil nil 'comment))) `(form (@ (action ,(concat "/" project "/new/")) (method "POST") (class "form-horizontal")) (fieldset (legend "New issue") (div (@ (class "row")) (div (@ (class "span5")) ,(eliss-control-group "subject" "Subject" "I wanna say...") ,(eliss-control-group "category" "Category" nil "bug") ,(eliss-control-group "tags" "Tags" "tag1:tag2") ,(eliss-control-group "name" "Name" "John Doe") ,(eliss-control-group "email" "Email" "john@example.com") (input (@ (type "hidden") (name "i-m-human") (value "t"))) (input (@ (type "hidden") (name "i-r-bot"))) (input (@ (type "submit") (value "Complain") (class "pull-right")))) (div (@ (class "span7")) (label (@ (for "content")) "Issue:") (textarea (@ (name "content") (id "content") (class "span7") (rows "15")) ""))))))))) (defun eliss-issue-page (httpcon) (let* ((project (match-string 1 (elnode-http-mapping httpcon))) (issue (match-string 2 (elnode-http-mapping httpcon))) (filename (concat eliss-data-directory "/" project ".org")) (buffer (find-file-noselect filename)) (entry (cdr (org-id-find issue)))) (elnode-http-start httpcon 200 '("Content-Type" . "text/html")) (with-current-buffer buffer (goto-char entry) (elnode-http-return httpcon (eliss-page project `(h1 ,(nth 4 (org-heading-components))) `(div (@ (class "row")) (div (@ (class "span6")) (dl (@ (class "dl-horizontal")) (dt "Status:") (dd ,(org-entry-get entry "TODO")))) (div (@ (class "span6")) (dl (@ (class "dl-horizontal")) (dt "Tags:") (dd ,(org-entry-get entry "TAGS")) (dt "Category:") (dd ,(org-entry-get entry "CATEGORY"))))) `(pre ,(buffer-substring-no-properties (org-end-of-meta-data-and-drawers) (org-entry-end-position))) `(div ,@(progn (org-goto-first-child) (org-map-entries (lambda () `(div (h2 ,(nth 4 (org-heading-components))) (pre ,(buffer-substring-no-properties (org-end-of-meta-data-and-drawers) (org-entry-end-position))))) nil 'tree)))))))) (defun eliss-new-issue (httpcon) (elnode-method httpcon (POST (let* ((project (match-string 1 (elnode-http-mapping httpcon))) (filename (concat eliss-data-directory "/" project ".org")) (buffer (find-file-noselect filename)) (subject (elnode-http-param httpcon "subject")) (tags (elnode-http-param httpcon "tags")) (i-m-human (elnode-http-param httpcon "i-m-human")) (i-r-bot (elnode-http-param httpcon "i-r-bot")) (content (elnode-http-param httpcon "content")) (category (elnode-http-param httpcon "category"))) (when (and (equal i-m-human "t") (equal i-r-bot "")) (with-current-buffer buffer (goto-char (point-min)) (unless (org-at-heading-p) (org-forward-heading-same-level nil)) (org-insert-todo-heading t) (insert subject) (let ((text-start (point))) (insert "\n\n " content) (fill-region text-start (point))) (org-set-tags-to tags) (org-set-property "CATEGORY" category) (org-set-property "ID" (org-id-new project)) (save-buffer))) (elnode-send-redirect httpcon (concat "/" project "/")))))) (defun eliss-handler (httpcon) (elnode-dispatcher httpcon '(("^/$" . eliss-project-list) ("^/\\([-a-zA-Z0-9]+\\)/$" . eliss-project-page) ("^/\\([-a-zA-Z0-9]+\\)/\\([-a-z0-9:]+\\)/$" . eliss-issue-page) ("^/\\([-a-zA-Z0-9]+\\)/new/$" . eliss-new-issue)))) (elnode-start 'eliss-handler :port 8028 :host "localhost")