2013-05-17 21:57:14 +02:00
|
|
|
;;; eliss --- Issue tracking with elnode and org-mode
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; eliss is a web interface for issue tracking with `org-mode'. It
|
|
|
|
|
;; uses elnode to provide the web interface and edits a number of org
|
|
|
|
|
;; files to keep track of state and such.
|
|
|
|
|
|
2013-05-16 02:22:55 +02:00
|
|
|
(require 'elnode)
|
|
|
|
|
(require 'esxml)
|
|
|
|
|
(require 'cl-lib)
|
|
|
|
|
|
2013-05-17 21:57:14 +02:00
|
|
|
;;; Code:
|
|
|
|
|
|
2013-05-16 02:22:55 +02:00
|
|
|
(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))
|
2013-05-17 01:29:26 +02:00
|
|
|
(entry (cdr (org-id-find issue)))
|
|
|
|
|
title)
|
2013-05-16 02:22:55 +02:00
|
|
|
(elnode-http-start httpcon 200 '("Content-Type" . "text/html"))
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(goto-char entry)
|
2013-05-17 01:29:26 +02:00
|
|
|
(set 'title (nth 4 (org-heading-components)))
|
2013-05-16 02:22:55 +02:00
|
|
|
(elnode-http-return
|
|
|
|
|
httpcon (eliss-page
|
|
|
|
|
project
|
2013-05-17 01:29:26 +02:00
|
|
|
`(h1 ,title)
|
2013-05-16 02:22:55 +02:00
|
|
|
`(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)))
|
2013-05-17 01:29:26 +02:00
|
|
|
`(div ,@(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)))))
|
|
|
|
|
"/+COMMENT" 'tree))
|
|
|
|
|
`(form (@ (action ,(concat "/" project "/" issue
|
|
|
|
|
"/comment/"))
|
|
|
|
|
(method "POST")
|
|
|
|
|
(class "form-horizontal"))
|
|
|
|
|
(fieldset
|
|
|
|
|
(legend "New comment")
|
|
|
|
|
(div (@ (class "row"))
|
|
|
|
|
(div (@ (class "span5"))
|
|
|
|
|
,(eliss-control-group
|
|
|
|
|
"subject" "Subject" nil
|
|
|
|
|
(concat "RE: " title))
|
|
|
|
|
,(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 "Comment")
|
|
|
|
|
(class "pull-right"))))
|
|
|
|
|
(div (@ (class "span7"))
|
|
|
|
|
(label (@ (for "content")) "Comment:")
|
|
|
|
|
(textarea (@ (name "content")
|
|
|
|
|
(id "content")
|
|
|
|
|
(class "span7")
|
|
|
|
|
(rows "15")) ""))))))))))
|
2013-05-16 02:22:55 +02:00
|
|
|
|
|
|
|
|
(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 "/"))))))
|
|
|
|
|
|
2013-05-17 01:29:26 +02:00
|
|
|
(defun eliss-new-comment (httpcon)
|
|
|
|
|
(elnode-method httpcon
|
|
|
|
|
(POST
|
|
|
|
|
(let* ((project (match-string 1 (elnode-http-mapping httpcon)))
|
|
|
|
|
(issue (match-string 2 (elnode-http-mapping httpcon)))
|
|
|
|
|
(entry (cdr (org-id-find issue)))
|
|
|
|
|
(filename (concat eliss-data-directory "/" project ".org"))
|
|
|
|
|
(buffer (find-file-noselect filename))
|
|
|
|
|
(subject (elnode-http-param httpcon "subject"))
|
|
|
|
|
(name (elnode-http-param httpcon "name"))
|
|
|
|
|
(email (elnode-http-param httpcon "email"))
|
|
|
|
|
(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")))
|
|
|
|
|
(when (and (equal i-m-human "t") (equal i-r-bot ""))
|
|
|
|
|
(with-current-buffer buffer
|
|
|
|
|
(goto-char entry)
|
|
|
|
|
(org-end-of-subtree)
|
|
|
|
|
(org-insert-heading-after-current)
|
|
|
|
|
(insert subject)
|
|
|
|
|
(org-set-property "TODO" "COMMENT")
|
|
|
|
|
(let ((text-start (point)))
|
|
|
|
|
(insert "\n\n" content)
|
|
|
|
|
(fill-region text-start (point)))
|
|
|
|
|
(save-buffer)))
|
|
|
|
|
(elnode-send-redirect httpcon (concat "/" project "/" issue "/"))))))
|
|
|
|
|
|
2013-05-16 02:22:55 +02:00
|
|
|
(defun eliss-handler (httpcon)
|
|
|
|
|
(elnode-dispatcher
|
|
|
|
|
httpcon
|
|
|
|
|
'(("^/$" . eliss-project-list)
|
|
|
|
|
("^/\\([-a-zA-Z0-9]+\\)/$" . eliss-project-page)
|
2013-05-17 01:29:26 +02:00
|
|
|
("^/\\([-a-zA-Z0-9]+\\)/new/$" . eliss-new-issue)
|
2013-05-16 02:22:55 +02:00
|
|
|
("^/\\([-a-zA-Z0-9]+\\)/\\([-a-z0-9:]+\\)/$" . eliss-issue-page)
|
2013-05-17 01:29:26 +02:00
|
|
|
("^/\\([-a-zA-Z0-9]+\\)/\\([-a-z0-9:]+\\)/comment/$" . eliss-new-comment))))
|
2013-05-16 02:22:55 +02:00
|
|
|
|
|
|
|
|
(elnode-start 'eliss-handler :port 8028 :host "localhost")
|
2013-05-17 21:57:14 +02:00
|
|
|
|
|
|
|
|
(provide 'eliss)
|
|
|
|
|
|
|
|
|
|
;;; eliss.el ends here
|
