From e11f5a59dc4910799b231b02897d5ece8d816654 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>
Date: Thu, 23 Oct 2014 17:39:52 +0200
Subject: initial commit

---
 grid-engine-mode.el | 132 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)
 create mode 100644 grid-engine-mode.el

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))
-- 
cgit v1.2.3