Download
(defconst cruisecontrol-version "0.2")
(defgroup cruisecontrol
'()
"Cruisecontrol commands for emacs.")
(defcustom cruisecontrol-webserver
""
"Webserver (host and port) which accepts commands."
:type 'string
:group 'cruisecontrol)
(defcustom cruisecontrol-post-build-hooks
'()
"Functions to execute when a cruisectrol build has been launched."
:type 'hook
:group 'cruisecontrol)
(defcustom cruisecontrol-projects
'()
"List of Cruise Control Projects. Not currently in use."
:type 'list
:group 'cruisecontrol)
(defcustom cruisecontrol-debug
't
"Debug the cruisecontrol interface?"
:type 'boolean
:group 'cruisecontrol)
(defun cruisecontrol-get-attribute-url (object attribute format template)
"Retrieve tha attributes on the cruisecontrol server."
(let* ((url
(concat "http://"
cruisecontrol-webserver
"/getattribute?"
"objectname=" (url-hexify-string object)
"&"
"attribute=" (url-hexify-string attribute)
"&"
"format=" (url-hexify-string format)
"&"
"template=" (url-hexify-string template))))
(when cruisecontrol-debug
(message "CruiseControl Attribute URL is: %s" url))
url))
(defun cruisecontrol-get-invoke-url (operation object)
"Return tthe url to execute the operation with object on the cruisecontrol server."
(let ((url
(concat "http://"
cruisecontrol-webserver
"/invoke?"
"operation=" (url-hexify-string operation)
"&"
"objectname=" (url-hexify-string object))))
(when cruisecontrol-debug
(message "cruisecontrol operation url: %s" url))
url))
(defun cruisecontrol-get-build-url (project)
(cruisecontrol-get-invoke-url "build"
(concat "CruiseControl Project:name=" project)))
(defvar cruisecontrol-url-buffer 'nil)
(defun cruisecontrol-get-projects ()
(interactive)
(let ((result nil))
(save-window-excursion
(set-buffer (url-retrieve-synchronously (cruisecontrol-get-attribute-url "CruiseControl Manager:id=unique" "Projects" "collection" "viewcollection")))
(goto-char (point-min))
(setq result (buffer-string))
(kill-buffer (current-buffer))
(message "Result is: %S" result))))
(defun cruisecontrol-build (project)
"Launches a cruisecontrol build."
(interactive "sCruise Control Project To Launch: ")
(setq cruisecontrol-url-buffer (url-retrieve (cruisecontrol-get-build-url project) 'cruisecontrol-build-executed)))
(defun cruisecontrol-build-executed (status)
(run-hooks 'cruisecontrol-post-build-hooks))
(if (featurep 'todochiku)
(add-hook 'cruisecontrol-post-build-hooks
(lambda ()
(todochiku-message "Cruise Control"
"build Started."
(todochiku-icon 'compile)))))
(provide 'cruisecontrol)