5c0265d7062af4a79194783a2b9ee01f046472e8
[software/grid-engine-mode.git] / grid-engine-mode.el
1 ;;; -*- lexical-binding: t -*-
2 (require 'derived)
3
4 (define-derived-mode grid-engine-list-mode
5 tabulated-list-mode "Grid Engine"
6 "Major mode for interacting with Grid Engine.
7 \\{grid-engine-mode-list-mode-map}"
8 (interactive)
9 (kill-all-local-variables)
10 (setq major-mode 'grid-engine-list-mode)
11 (setq mode-name "Grid Engine")
12 (grid-engine--init-keymap)
13 (grid-engine--init-header)
14
15 (add-hook 'tabulated-list-revert-hook
16 (lambda ()
17 (grid-engine--init-header)
18 (grid-engine-list-jobs)))
19 (use-local-map grid-engine-list-mode-map)
20 (run-hooks 'grid-engine-hook))
21
22 (defcustom grid-engine-host nil
23 "The host on which Grid Engine is running. Defaults to localhost.")
24 (defcustom grid-engine-qstat "/opt/sge/bin/lx-amd64/qstat"
25 "The full path to the qstat executable.")
26 (defcustom grid-engine-user nil
27 "The grid engine user. Defaults to the logged in user's name.")
28 (defcustom grid-engine-column-order '(job-id time priority owner state)
29 "The order of job columns to be displayed. The following keys are valid: job-id, priority, name, owner, state, time, queue, slots.")
30
31 (defun grid-engine--init-keymap ()
32 (setq grid-engine-list-mode-map (make-keymap))
33 ;; disable all key bindings
34 (suppress-keymap grid-engine-list-mode-map)
35 (define-key grid-engine-list-mode-map (kbd "n") 'next-logical-line)
36 (define-key grid-engine-list-mode-map (kbd "p") 'previous-logical-line)
37 (define-key grid-engine-list-mode-map (kbd "q") 'bury-buffer)
38 (define-key grid-engine-list-mode-map (kbd "g") 'revert-buffer)
39 (define-key grid-engine-list-mode-map (kbd "<RET>")
40 (lambda (&optional arg)
41 (interactive)
42 (let ((field (get-text-property (point) 'field))
43 (job (get-text-property (point) 'grid-engine-job)))
44 (unless (and field job)
45 (error "[Grid Engine] point is not on a field of a job record"))
46 (grid-engine-job-details job arg)))))
47
48 (defun grid-engine--init-header ()
49 (grid-engine-update-list-format)
50 (tabulated-list-init-header))
51
52 (defun grid-engine-update-list-format ()
53 "Compute value of tabulated-list-format from grid-engine-column-order."
54 (setq columns '((job-id . ("Job-ID" 10 t))
55 (priority . ("Priority" 10 t))
56 (name . ("Job name" 10 t))
57 (owner . ("User" 15 t))
58 (state . ("State" 15 t))
59 (time . ("Time" 25 t))
60 (queue . ("Queue" 25 t))
61 (slots . ("Slots" 10 t))))
62 (setq tabulated-list-format
63 (vconcat (mapcar (lambda (key)
64 (cdr (assoc key columns)))
65 grid-engine-column-order))))
66
67 (defun grid-engine--raise-buffer (&optional buffer)
68 (when buffer
69 (set-buffer buffer))
70 (goto-char (point-min))
71 (pop-to-buffer-same-window (current-buffer))
72 (grid-engine))
73
74 (defun grid-engine--split-buffer (&optional buffer)
75 (when buffer
76 (set-buffer buffer))
77 (goto-char (point-min))
78 (display-buffer (current-buffer))
79 (grid-engine))
80
81 (defun grid-engine--default-directory ()
82 (if grid-engine-host
83 (concat "/ssh:" grid-engine-host ":")
84 default-directory))
85
86 (defun grid-engine--cmd-to-buffer (cmd &optional buffer-name)
87 "Run a command CMD on the Grid Engine host and write output to BUFFER-NAME. If BUFFER-NAME is nil, write to current buffer."
88 (let ((default-directory (grid-engine--default-directory)))
89 (when buffer-name
90 (set-buffer (get-buffer-create buffer-name))
91 (erase-buffer))
92 (process-file-shell-command cmd nil (current-buffer) t)))
93
94 (defun grid-engine--cmd-to-xmltree (cmd)
95 "Run a command CMD on the Grid Engine host and return output as list of strings."
96 (with-temp-buffer
97 (grid-engine--cmd-to-buffer cmd)
98 (libxml-parse-xml-region 1 (buffer-size))))
99
100 (defun grid-engine-list-jobs ()
101 "List all jobs for the specified user in a new buffer."
102 (defun field-as-text (field obj &optional format-string)
103 (let* ((value (cdr (assoc field obj)))
104 (format-string (if format-string format-string
105 "%s"))
106 (text (format format-string value)))
107 (propertize text 'field value)))
108
109 (defun job-to-row (job)
110 (let ((contents (vconcat (mapcar (lambda (key)
111 (field-as-text key job))
112 grid-engine-column-order))))
113 (list job contents)))
114
115 (defun mkjob-alist (subtree)
116 "Convert a parsed XML subtree for a job entry to an alist."
117 (cl-reduce
118 (lambda (acc field)
119 (let ((name (case (car field)
120 ('JB_job_number 'job-id)
121 ('JAT_prio 'priority)
122 ('JB_name 'name)
123 ('JB_owner 'owner)
124 ('state 'state)
125 ('JAT_start_time 'time)
126 ('queue_name 'queue)
127 ('slots 'slots)
128 (t nil))))
129 (if name
130 (cons (cons name (caddr field)) acc)
131 acc)))
132 (cdr subtree) :initial-value nil))
133
134 (let* ((user (if grid-engine-user grid-engine-user
135 (user-login-name)))
136 (cmd (concat grid-engine-qstat " -xml -u " user))
137 (title "*grid-engine-jobs*"))
138 (message "[Grid Engine] fetching list of jobs for %s ..." user)
139 (let* ((tree (grid-engine--cmd-to-xmltree cmd))
140 (jobs (mapcar 'mkjob-alist (cddr (caddr tree)))))
141 (set-buffer (get-buffer-create title))
142 (setq tabulated-list-entries
143 (mapcar (lambda (job)
144 (job-to-row job))
145 jobs)))
146 (grid-engine--raise-buffer)
147 ;; update list
148 (tabulated-list-print)
149 (message nil)))
150
151 (defun grid-engine-job-details (job &optional new-buffer)
152 (let* ((job-id (cdr (assoc 'job-id job)))
153 (cmd (concat grid-engine-qstat " -j " job-id))
154 (title (if new-buffer
155 (concat "*grid-engine-job-details-" job-id "*")
156 "*grid-engine-job-details*")))
157 (message "[Grid Engine] fetching details for job %s" job-id)
158 (grid-engine--cmd-to-buffer cmd title)
159 (grid-engine--split-buffer)))
160
161 (provide 'grid-engine-mode)