diff options
author | Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> | 2014-10-23 17:39:52 +0200 |
---|---|---|
committer | Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> | 2014-10-23 17:44:39 +0200 |
commit | e11f5a59dc4910799b231b02897d5ece8d816654 (patch) | |
tree | 7567086cfff8f0b59396fc097fd334ce5533460b |
initial commit
-rw-r--r-- | grid-engine-mode.el | 132 |
1 files changed, 132 insertions, 0 deletions
diff --git a/grid-engine-mode.el b/grid-engine-mode.el new file mode 100644 index 0000000..cb6deef --- /dev/null +++ b/grid-engine-mode.el @@ -0,0 +1,132 @@ +;;; -*- lexical-binding: t -*- + +(defcustom grid-engine-map nil + "Keymap for Grid Engine mode.") +(defcustom grid-engine-host nil + "The host on which Grid Engine is running. Defaults to localhost.") +(defcustom grid-engine-qstat "/opt/sge/bin/lx-amd64/qstat" + "The full path to the qstat executable.") +(defcustom grid-engine-user nil + "The grid engine user. Defaults to the logged in user's name.") + +(defun grid-engine-setup () + (if grid-engine-map + nil + (setq grid-engine-map (make-keymap)) + ;; disable all key bindings + (suppress-keymap grid-engine-map) + (define-key grid-engine-map (kbd "n") 'next-logical-line) + (define-key grid-engine-map (kbd "p") 'previous-logical-line) + (define-key grid-engine-map (kbd "q") 'bury-buffer) + (define-key grid-engine-map (kbd "<RET>") + (lambda (&optional arg) + (interactive) + (grid-engine-job-details (thing-at-point 'word) arg))) + (define-key grid-engine-map (kbd "g") + (lambda () (interactive) (grid-engine-list-jobs))))) + +(defun grid-engine--raise-buffer (&optional buffer) + (when buffer + (set-buffer buffer)) + (pop-to-buffer-same-window (current-buffer)) + (beginning-of-buffer) + (grid-engine)) + +(defun grid-engine--split-buffer (&optional buffer) + (when buffer + (set-buffer buffer)) + (display-buffer (current-buffer)) + (beginning-of-buffer) + (grid-engine)) + +(defun grid-engine--default-directory () + (if grid-engine-host + (concat "/ssh:" grid-engine-host ":") + default-directory)) + +(defun grid-engine--cmd-to-buffer (cmd &optional buffer-name) + "Run a command CMD on the Grid Engine host and write output to BUFFER-NAME. If BUFFER-NAME is nil, write to current buffer." + (let ((default-directory (grid-engine--default-directory))) + (when buffer-name + (set-buffer (get-buffer-create buffer-name)) + (erase-buffer)) + (process-file-shell-command cmd nil (current-buffer) t))) + +(defun grid-engine--cmd-to-xmltree (cmd) + "Run a command CMD on the Grid Engine host and return output as list of strings." + (with-temp-buffer + (grid-engine--cmd-to-buffer cmd) + (libxml-parse-xml-region 1 (buffer-size)))) + + +(defun grid-engine-list-jobs () + "List all jobs for the specified user in a new buffer." + (setq row-pattern "%-10s %-10s %-15s %-10s\n") + (setq header (format (concat row-pattern "\n") + "Job-ID" + "Priority" + "User" + "State")) + (defun format-job-record (job) + (format row-pattern + (cdr (assoc 'job-id job)) + (cdr (assoc 'priority job)) + (cdr (assoc 'owner job)) + (cdr (assoc 'state job)))) + + (defun mkjob-alist (subtree) + "Convert a parsed XML subtree for a job entry to an alist." + (cl-reduce + (lambda (acc field) + (let ((name (case (car field) + ('JB_job_number 'job-id) + ('JAT_prio 'priority) + ('JB_name 'name) + ('JB_owner 'owner) + ('state 'state) + ('JAT_start_time 'time) + ('queue_name 'queue) + ('slots 'slots) + (t nil)))) + (if name + (cons (cons name (caddr field)) acc) + acc))) + (cdr subtree) :initial-value nil)) + + (let* ((user (if grid-engine-user grid-engine-user + (user-login-name))) + (cmd (concat grid-engine-qstat " -xml -u " user)) + (title "*grid-engine-jobs*")) + (message "[Grid Engine] fetching list of jobs for %s ..." user) + (let* ((tree (grid-engine--cmd-to-xmltree cmd)) + (jobs (mapcar 'mkjob-alist (cddr (caddr tree))))) + (set-buffer (get-buffer-create title)) + (erase-buffer) + (insert header) + (mapcar (lambda (job) + (insert (format-job-record job))) + jobs)) + (grid-engine--raise-buffer) + (message nil))) + +(defun grid-engine-job-details (job-id &optional new-buffer) +; (unless (number-or-marker-p job-id) +; (error "[Grid Engine] %s is not a valid job id.")) + (let ((cmd (concat grid-engine-qstat " -j " job-id)) + (title (if new-buffer + (concat "*grid-engine-job-details-" job-id "*") + "*grid-engine-job-details*"))) + (message "[Grid Engine] fetching details for job %s" job-id) + (grid-engine--cmd-to-buffer cmd title) + (grid-engine--split-buffer))) + + +(defun grid-engine () + "Major mode for interacting with Grid Engine." + (interactive) + (kill-all-local-variables) + (setq major-mode 'grid-engine) + (setq mode-name "Grid Engine") + (grid-engine-setup) + (use-local-map grid-engine-map) + (run-hooks 'grid-engine-hook)) |