;;; 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. (require 'cl-lib) (require 'elnode) (require 'esxml) (require 'org) ;;; Code: (defvar eliss-data-directory "~/projects/eliss/projects" "The location of the project org files.") (defmacro with-eliss-http-params (params httpcon &rest body) "Bind parameters PARAMS from HTTPCON and execute BODY." `(let (,@(mapcar (lambda (p) `(,p (elnode-http-param ,httpcon ,(symbol-name p)))) params)) ,@body)) (put 'with-eliss-http-params 'lisp-indent-function 2) (defun eliss-project-row (project) "Print a table row for PROJECT." (let ((pname (substring project 0 -4))) `(tr (td (a (@ (href ,(concat "/" pname "/"))) ,pname))))) (defun eliss-page (title &rest body) "Create a page with some default necessities. Set the page's title and brand to TITLE and add BODY in the container div." (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) "Send a list of known projects over HTTPCON." (elnode-http-start httpcon 200 '("Content-Type" . "text/html")) (elnode-http-return httpcon (eliss-page "project list" `(table (@ (class "table")) ,@(mapcar #'eliss-project-row (directory-files eliss-data-directory nil "\\.org$")))))) (defun eliss-control-group (name label &rest plist) "Return an often-used common HTML structure. Set the name and id attributes of the input to NAME, give it the label LABEL. The property list PLIST can be used to define certain other properties. - `:default' may specify a default value to appear in the input. - `:placeholder' may specify a placeholder for the input, which appears if no value has been given." (let ((default (plist-get plist :default)) (placeholder (plist-get plist :placeholder))) `(div (@ (class "control-group")) (label (@ (class "control-label") (for ,name)) ,label) (div (@ (class "controls")) (input (@ (type "text") (name ,name) (id ,name) ,@(when placeholder `((placeholder ,placeholder))) ,@(when default `((value ,default))))))))) (defun eliss-hidden-input (name &rest plist) "Create a input with type hidden. Give it the name NAME and take some other properties from proprety list PLIST: - `:value' specifies the value attribute the input should get." (let ((value (plist-get plist :value))) `(input (@ (type "hidden") (name ,name) ,@(when value `((value ,value))))))) (defun eliss-project-page (httpcon) "Send a list of issues and an issue-creation form over 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" :placeholder "I wanna say...") ,(eliss-control-group "category" "Category" :default "bug") ,(eliss-control-group "tags" "Tags" :placeholder "tag1:tag2") ,(eliss-control-group "name" "Name" :placeholder "John Doe") ,(eliss-control-group "email" "Email" :placeholder "john@example.com") ,(eliss-hidden-input "i-m-human" :value "t") ,(eliss-hidden-input "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-current-entry-content () "Get the content of the org entry currently at point." (buffer-substring-no-properties (org-end-of-meta-data-and-drawers) (org-entry-end-position))) (defun eliss-issue-page (httpcon) "Send an issue-detail page over 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))) title) (elnode-http-start httpcon 200 '("Content-Type" . "text/html")) (with-current-buffer buffer (goto-char entry) (set 'title (nth 4 (org-heading-components))) (elnode-http-return httpcon (eliss-page project `(h1 ,title) `(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 ,(eliss-current-entry-content)) `(div ,@(org-map-entries (lambda () `(div (h2 ,(nth 4 (org-heading-components))) (pre ,(eliss-current-entry-content)))) "/+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" :default (concat "RE: " title) :required t) ,(eliss-control-group "name" "Name" :placeholder "John Doe" :required t) ,(eliss-control-group "email" "Email" :placeholder "john@example.com" :required t) ,(eliss-hidden-input "i-m-human" :value "t") ,(eliss-hidden-input "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")) "")))))))))) (defun eliss-new-issue (httpcon) "Parse data from HTTPCON and write a new issue using it." (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))) (with-eliss-http-params (subject tags i-m-human i-r-bot content category name email) httpcon (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)) (org-set-property "AuthorName" name) (org-set-property "AuthorEmail" email) (save-buffer)))) (elnode-send-redirect httpcon (concat "/" project "/")))))) (defun eliss-new-comment (httpcon) "Parse data from HTTPCON and write a new issue comment using it." (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))) (with-eliss-http-params (subject name email i-m-human i-r-bot content) httpcon (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) (org-demote) (insert subject) (org-set-property "TODO" "COMMENT") (let ((text-start (point))) (insert "\n\n" content) (fill-region text-start (point))) (org-set-property "AuthorName" name) (org-set-property "AuthorEmail" email) (save-buffer)))) (elnode-send-redirect httpcon (concat "/" project "/" issue "/")))))) (defun eliss-handler (httpcon) "Send the right requests in HTTPCON to the right functions." (elnode-dispatcher httpcon '(("^/$" . eliss-project-list) ("^/\\([-a-zA-Z0-9]+\\)/$" . eliss-project-page) ("^/\\([-a-zA-Z0-9]+\\)/new/$" . eliss-new-issue) ("^/\\([-a-zA-Z0-9]+\\)/\\([-a-z0-9:]+\\)/$" . eliss-issue-page) ("^/\\([-a-zA-Z0-9]+\\)/\\([-a-z0-9:]+\\)/comment/$" . eliss-new-comment)))) (elnode-start 'eliss-handler :port 8028 :host "localhost") (provide 'eliss) ;;; eliss.el ends here