157 lines
6.3 KiB
EmacsLisp
157 lines
6.3 KiB
EmacsLisp
;;; el/conduct.el -*- lexical-binding: t; -*-
|
|
|
|
(defun conduct-run ()
|
|
"Run a task or task group defined in the current project"
|
|
(interactive)
|
|
|
|
(let* (
|
|
(config-data (conduct/load-config))
|
|
(tasks (alist-get 'tasks config-data))
|
|
(groups (alist-get 'groups config-data))
|
|
(select-tasks (append (mapcar 'conduct/format-task-name tasks) nil))
|
|
(select-groups (append (mapcar 'conduct/format-group-name groups) nil))
|
|
(items (seq-remove #'conduct/is-running (append select-tasks select-groups)))
|
|
(selected-name (conduct/extract-name-from-selection (completing-read "Task: " items)))
|
|
(task-names (conduct/get-task-name selected-name config-data))
|
|
(group-names (conduct/get-group-name selected-name config-data))
|
|
(names (append task-names group-names)))
|
|
(dolist (name names)
|
|
(unless (conduct/get-task-buffer (conduct/get-named-task name config-data))
|
|
(conduct/run-task (conduct/get-named-task name config-data))))))
|
|
|
|
(defun conduct-kill ()
|
|
"Kill a defined project task"
|
|
(interactive)
|
|
|
|
(let* (
|
|
(config-data (conduct/load-config))
|
|
(tasks (alist-get 'tasks config-data))
|
|
(groups (alist-get 'groups config-data))
|
|
(select-tasks (seq-filter #'conduct/is-running (append (mapcar 'conduct/format-task-name tasks) nil)))
|
|
(select-groups (append (mapcar 'conduct/format-group-name groups) nil))
|
|
(items (append select-tasks select-groups))
|
|
(selected-name (conduct/extract-name-from-selection (completing-read "Task: " items)))
|
|
(task-names (conduct/get-task-name selected-name config-data))
|
|
(group-names (conduct/get-group-name selected-name config-data))
|
|
(names (append task-names group-names)))
|
|
|
|
(dolist (name names)
|
|
(conduct/kill-task (conduct/get-named-task name config-data)))))
|
|
|
|
(defun conduct-show ()
|
|
"Kill a defined project task"
|
|
(interactive)
|
|
|
|
(let* (
|
|
(config-data (conduct/load-config))
|
|
(tasks (alist-get 'tasks config-data))
|
|
(select-tasks (seq-filter #'conduct/is-running (append (mapcar 'conduct/format-task-name tasks) nil)))
|
|
(selected-name (conduct/extract-name-from-selection (completing-read "Task: " select-tasks))))
|
|
|
|
(switch-to-buffer (format "task-%s" selected-name))))
|
|
|
|
(defun conduct/create-task-path (task)
|
|
"Generate a new path based on the project root and the path for TASK"
|
|
(concat
|
|
(file-name-as-directory (project-root (project-current)))
|
|
(or (alist-get 'path task) ".")))
|
|
|
|
|
|
(defun conduct/load-config ()
|
|
"Load the conduct.json config file from the current project root"
|
|
(let* (
|
|
(config-file (concat
|
|
(file-name-as-directory (project-root (project-current)))
|
|
"conduct.json")))
|
|
(json-read-file config-file)))
|
|
|
|
(defun conduct/get-named-task (name data)
|
|
"Return the task for NAME. NAME is assumed to be a string"
|
|
(assoc (intern name) (alist-get 'tasks data)))
|
|
|
|
(defun conduct/get-task-name (name data)
|
|
"Returns the name of the task as a single item list. If it exists in DATA"
|
|
(when-let (name (assoc (intern name) (alist-get 'tasks data)))
|
|
(list (symbol-name (car name)))))
|
|
|
|
|
|
(defun conduct/get-group-name (name data)
|
|
"Returns a list of all tasks for the group named NAME in DATA"
|
|
(append (cdr (assoc (intern name) (alist-get 'groups data))) nil))
|
|
|
|
(defun conduct/run-task (task)
|
|
"Run the given task definition"
|
|
(let* (
|
|
(name (concat "task-" (symbol-name (car task))))
|
|
(buffer (concat "task-" (symbol-name (car task))))
|
|
(raw-cmd (alist-get 'command (cdr task)))
|
|
(task-cmd (concat "cd " (conduct/create-task-path (cdr task)) " && " raw-cmd))
|
|
(command (list "/bin/sh" "-c" task-cmd))
|
|
(process (make-process :name name :buffer buffer :command command :sentinel 'task-sentinel)))
|
|
|
|
(message "Running task: %s" name)
|
|
(with-current-buffer buffer
|
|
(require 'shell)
|
|
(shell-mode)
|
|
(setq-local conduct-task-name name)
|
|
(set-process-query-on-exit-flag process nil)
|
|
(set-process-filter process 'comint-output-filter))
|
|
buffer))
|
|
|
|
(defun conduct/get-task-buffer (task)
|
|
"Get the buffer related to a TASK defintiion"
|
|
(get-buffer (concat "task-" (symbol-name (car task)))))
|
|
|
|
(defun conduct/kill-task (task)
|
|
"Kill the process and buffer for a TASK"
|
|
(if-let* ((buffer (conduct/get-task-buffer task))
|
|
(process (get-buffer-process buffer)))
|
|
(progn
|
|
(kill-process (get-buffer-process buffer)))
|
|
(message "Task buffer not found for %s" (alist-get 'name task))))
|
|
|
|
(defun conduct/format-group-name (group)
|
|
"Format the name for GROUP that can be used in the popup selection"
|
|
(concat
|
|
(propertize (symbol-name (car group)) 'face 'outline-1)
|
|
(propertize "|" 'invisible t)
|
|
" "
|
|
(propertize (mapconcat #'identity (cdr group) ", ") 'face 'org-archived)))
|
|
|
|
(defun conduct/extract-name-from-selection (selection)
|
|
(car (split-string selection "|")))
|
|
|
|
(defun conduct/is-running (task-name)
|
|
(let* (
|
|
(process-name (concat "task-" (conduct/extract-name-from-selection task-name))))
|
|
(member process-name (mapcar #'process-name (process-list)))))
|
|
|
|
(defun conduct/format-task-name (task)
|
|
"Format the name for TASK to be used in the popup selection"
|
|
(let* (
|
|
(task-name (symbol-name (car task))))
|
|
(concat
|
|
(propertize task-name 'face 'bold)
|
|
(propertize "|" 'invisible t)
|
|
(propertize " ")
|
|
(propertize (alist-get 'command (cdr task)) 'face 'org-archived))))
|
|
|
|
(defun check-signal (sig s)
|
|
"Check the process signal against a value"
|
|
(and (> (length s) (length sig)) (equal sig (substring s 0 (length sig)))))
|
|
|
|
(defun task-sentinel (process event)
|
|
"Monitor the task process and close the buffer if it ends"
|
|
(cond
|
|
((check-signal "finished" event)
|
|
(message "Task ended: %s" (buffer-name (process-buffer process)))
|
|
(kill-buffer (process-buffer process)))
|
|
((check-signal "exited" event) (kill-buffer (process-buffer process)))
|
|
((check-signal "deleted" event) (kill-buffer (process-buffer process)))
|
|
((check-signal "failed" event)
|
|
(message "Task failed: %s" (buffer-name (process-buffer process)))
|
|
(kill-buffer (process-buffer process)))
|
|
((check-signal "killed" event)
|
|
(kill-buffer (process-buffer process)))
|
|
(t (message (format "Process: %s had the event '%s'" process event)))))
|