ryuslash/eliss
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Initial commit

Browse source
This commit is contained in:
Tom Willemse 2013-05-16 02:22:55 +02:00
commit 506c9713e9
2 changed files with 175 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored Normal file
View file

@ -0,0 +1,2 @@
*.elc
projects/

173
eliss.el Normal file
View file

@ -0,0 +1,173 @@
(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
"<!DOCTYPE html>"
(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")