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