;;; 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)))))