197 lines
8.1 KiB
EmacsLisp
197 lines
8.1 KiB
EmacsLisp
;;; el/conduct.el -*- lexical-binding: t; -*-
|
|
|
|
|
|
(require 'shell)
|
|
(define-derived-mode conduct-mode shell-mode "Conduct"
|
|
"Conduct process buffer" :interactive nil
|
|
(read-only-mode)
|
|
(evil-define-key 'insert conduct-mode-map "q" 'conduct/buffer-kill)
|
|
(evil-define-key 'normal conduct-mode-map "r" 'conduct/buffer-restart)
|
|
(evil-define-key 'normal conduct-mode-map "r" 'conduct/buffer-restart)
|
|
(evil-define-key 'normal conduct-mode-map "q" 'conduct/buffer-kill))
|
|
|
|
(provide 'conduct-mode)
|
|
|
|
(defun conduct/buffer-restart () (interactive) (conduct/restart-task current-task))
|
|
(defun conduct/buffer-kill () (interactive) (conduct/kill-task current-task))
|
|
|
|
(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-restart ()
|
|
"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)))
|
|
(task (conduct/get-named-task selected-name config-data)))
|
|
(conduct/restart-task task)))
|
|
|
|
(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 'conduct/task-sentinal)))
|
|
(with-current-buffer buffer
|
|
(conduct-mode)
|
|
(setq-local current-task task)
|
|
(set-process-query-on-exit-flag process nil)
|
|
(set-process-filter process 'comint-output-filter)
|
|
(display-buffer buffer)
|
|
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/restart-task (task)
|
|
"Kill the process and buffer for a TASK"
|
|
(if-let* ((buffer (conduct/get-task-buffer task))
|
|
(old-process (get-buffer-process buffer))
|
|
(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))
|
|
(name (concat "task-" (symbol-name (car task)))))
|
|
(with-current-buffer buffer
|
|
(set-process-sentinel old-process (lambda(_process _event) (set-process-filter (make-process :name name :buffer buffer :command command :sentinel 'conduct/task-sentinal) 'comint-output-filter)))
|
|
(kill-process old-process))
|
|
(message "Task buffer not found for %s" (alist-get 'name 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 conduct/check-signal (sig s)
|
|
"Check the process signal against a value"
|
|
(and (> (length s) (length sig)) (equal sig (substring s 0 (length sig)))))
|
|
|
|
(defun conduct/task-sentinal (process event)
|
|
"Monitor the task process and close the buffer if it ends"
|
|
(cond
|
|
((conduct/check-signal "finished" event)
|
|
(message "Task ended: %s" (buffer-name (process-buffer process)))
|
|
(kill-buffer (process-buffer process)))
|
|
((conduct/check-signal "exited" event) (kill-buffer (process-buffer process)))
|
|
((conduct/check-signal "deleted" event) (kill-buffer (process-buffer process)))
|
|
((conduct/check-signal "failed" event)
|
|
(message "Task failed: %s" (buffer-name (process-buffer process)))
|
|
(kill-buffer (process-buffer process)))
|
|
((conduct/check-signal "killed" event)
|
|
(kill-buffer (process-buffer process)))
|
|
(t (message (format "Process: %s had the event '%s'" process event)))))
|