summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <ricardo.wurmus@mdc-berlin.de>2014-10-23 17:39:52 +0200
committerRicardo Wurmus <ricardo.wurmus@mdc-berlin.de>2014-10-23 17:44:39 +0200
commite11f5a59dc4910799b231b02897d5ece8d816654 (patch)
tree7567086cfff8f0b59396fc097fd334ce5533460b
initial commit
-rw-r--r--grid-engine-mode.el132
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))