;;; -*- lexical-binding: t -*-
(require 'derived)

(define-derived-mode grid-engine
  tabulated-list-mode "Grid Engine"
  "Major mode for interacting with Grid Engine.
          \\{grid-engine-mode-map}"
  (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))

(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 ()
    (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)
        (let ((field (get-text-property (point) 'field))
              (job   (get-text-property (point) 'grid-engine-job)))
          (unless (and field job)
            (error "[Grid Engine] point is not on a field of a job record"))
          (grid-engine-job-details field job arg))))
    (define-key grid-engine-map (kbd "g")
      (lambda () (interactive) (grid-engine-list-jobs)))

  (grid-engine-update-list-format)
  (tabulated-list-init-header))


(setq column-order '(job-id time priority owner state))
(defun grid-engine-update-list-format ()
  (setq columns '((job-id   . ("Job-ID"   10 nil))
                  (priority . ("Priority" 10 nil))
                  (name     . ("Job name" 10 nil))
                  (owner    . ("User"     15 nil))
                  (state    . ("State"    15 nil))
                  (time     . ("Time"     25 nil))
                  (queue    . ("Queue"    25 nil))
                  (slots    . ("Slots"    10 nil))))
  (setq tabulated-list-format
        (vconcat (mapcar (lambda (key)
                           (cdr (assoc key columns)))
                         column-order))))

(defun grid-engine--raise-buffer (&optional buffer)
  (when buffer
    (set-buffer buffer))
  (goto-char (point-min))
  (pop-to-buffer-same-window (current-buffer))
  (grid-engine))

(defun grid-engine--split-buffer (&optional buffer)
  (when buffer
    (set-buffer buffer))
  (goto-char (point-min))
  (display-buffer (current-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."
  (defun field-as-text (field obj &optional format-string)
    (let* ((value (cdr (assoc field obj)))
           (format-string (if format-string format-string
                            "%s"))
           (text  (format format-string value)))
      (propertize text 'field value)))

  (defun job-to-row (job)
    (let ((contents (vconcat (mapcar (lambda (key)
                                        (field-as-text key job))
                                      column-order))))
      (list job contents)))

  (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))
      (setq tabulated-list-entries
            (mapcar (lambda (job)
                      (job-to-row job))
                    jobs)))
    (grid-engine--raise-buffer)
    ;; update list
    (tabulated-list-print)
    (message nil)))

(defun grid-engine-job-details (field job &optional new-buffer)
  (let* ((job-id (cdr (assoc 'job-id job)))
         (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)))

(provide 'grid-engine-mode)