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