commit | author | age
|
5cb5f7
|
1 |
;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*- |
C |
2 |
|
|
3 |
;; Copyright (C) 2012 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com> |
|
4 |
|
|
5 |
;; This program is free software; you can redistribute it and/or modify |
|
6 |
;; it under the terms of the GNU General Public License as published by |
|
7 |
;; the Free Software Foundation, either version 3 of the License, or |
|
8 |
;; (at your option) any later version. |
|
9 |
|
|
10 |
;; This program is distributed in the hope that it will be useful, |
|
11 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
12 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
13 |
;; GNU General Public License for more details. |
|
14 |
|
|
15 |
;; You should have received a copy of the GNU General Public License |
|
16 |
;; along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
17 |
|
|
18 |
;;; Code: |
|
19 |
|
|
20 |
(require 'cl-lib) |
|
21 |
(require 'helm) |
|
22 |
(require 'helm-help) |
|
23 |
(require 'helm-utils) |
|
24 |
|
|
25 |
|
|
26 |
(defgroup helm-sys nil |
|
27 |
"System related helm library." |
|
28 |
:group 'helm) |
|
29 |
|
|
30 |
(defface helm-top-columns |
|
31 |
'((t :inherit helm-header)) |
|
32 |
"Face for helm help string in minibuffer." |
|
33 |
:group 'helm-sys) |
|
34 |
|
|
35 |
|
|
36 |
(defcustom helm-top-command |
|
37 |
(cl-case system-type |
|
38 |
(darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start_time,vsz,%%cpu,%%mem,etime,command") |
|
39 |
(t "env COLUMNS=%s top -b -n 1")) |
|
40 |
"Top command used to display output of top. |
|
41 |
A format string where %s will be replaced with `frame-width'. |
|
42 |
|
|
43 |
To use 'top' command, a version supporting batch mode (-b option) is needed. |
|
44 |
On Mac OSX 'top' command doesn't support this, so ps command |
|
45 |
is used instead by default. |
|
46 |
Normally 'top' command output have 12 columns, but in some versions you may |
|
47 |
have less than this, so you can either customize top to use 12 columns with the |
|
48 |
interactives 'f' and 'W' commands of top, or modify |
|
49 |
`helm-top-sort-columns-alist' to fit with the number of columns |
|
50 |
your 'top' command is using. |
|
51 |
|
|
52 |
If you modify 'ps' command be sure that 'pid' comes in first |
|
53 |
and \"env COLUMNS=%s\" is specified at beginning of command. |
|
54 |
Ensure also that no elements contain spaces (e.g use start_time and not start). |
|
55 |
Same as for 'top' you can customize `helm-top-sort-columns-alist' to make sort commands |
|
56 |
working properly according to your settings." |
|
57 |
:group 'helm-sys |
|
58 |
:type 'string) |
|
59 |
|
|
60 |
(defcustom helm-top-sort-columns-alist '((com . 11) |
|
61 |
(mem . 9) |
|
62 |
(cpu . 8) |
|
63 |
(user . 1)) |
|
64 |
"Allow defining which column to use when sorting output of top/ps command. |
|
65 |
Only com, mem, cpu and user are sorted, so no need to put something else there, |
|
66 |
it will have no effect. |
|
67 |
Note that column numbers are counted from zero, i.e column 1 is the nth 0 column." |
|
68 |
:group 'helm-sys |
|
69 |
:type '(alist :key-type symbol :value-type (integer :tag "Column number"))) |
|
70 |
|
|
71 |
(defcustom helm-top-poll-delay 1.5 |
|
72 |
"Helm top poll after this delay when `helm-top-poll-mode' is enabled. |
|
73 |
The minimal delay allowed is 1.5, if less than this helm-top will use 1.5." |
|
74 |
:group 'helm-sys |
|
75 |
:type 'float) |
|
76 |
|
|
77 |
(defcustom helm-top-poll-delay-post-command 1.0 |
|
78 |
"Helm top stop polling during this delay. |
|
79 |
This delay is additioned to `helm-top-poll-delay' after emacs stop |
|
80 |
being idle." |
|
81 |
:group 'helm-sys |
|
82 |
:type 'float) |
|
83 |
|
|
84 |
(defcustom helm-top-poll-preselection 'linum |
|
85 |
"Stay on same line or follow candidate when `helm-top-poll' update display. |
|
86 |
Possible values are 'candidate or 'linum. |
|
87 |
This affect also sorting functions in the same way." |
|
88 |
:group'helm-sys |
|
89 |
:type '(radio :tag "Preferred preselection action for helm-top" |
|
90 |
(const :tag "Follow candidate" candidate) |
|
91 |
(const :tag "Stay on same line" linum))) |
|
92 |
|
|
93 |
;;; Top (process) |
|
94 |
;; |
|
95 |
;; |
|
96 |
(defvar helm-top-sort-fn nil) |
|
97 |
(defvar helm-top-map |
|
98 |
(let ((map (make-sparse-keymap))) |
|
99 |
(set-keymap-parent map helm-map) |
|
100 |
(define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu) |
|
101 |
(define-key map (kbd "M-C") 'helm-top-run-sort-by-com) |
|
102 |
(define-key map (kbd "M-M") 'helm-top-run-sort-by-mem) |
|
103 |
(define-key map (kbd "M-U") 'helm-top-run-sort-by-user) |
|
104 |
map)) |
|
105 |
|
|
106 |
(defvar helm-top-after-init-hook nil |
|
107 |
"Local hook for helm-top.") |
|
108 |
|
|
109 |
(defvar helm-top--poll-timer nil) |
|
110 |
|
|
111 |
(defun helm-top-poll (&optional no-update delay) |
|
112 |
(when helm-top--poll-timer |
|
113 |
(cancel-timer helm-top--poll-timer)) |
|
114 |
(condition-case nil |
|
115 |
(progn |
|
116 |
(when (and (helm--alive-p) (null no-update)) |
|
117 |
;; Fix quitting while process is running |
|
118 |
;; by binding `with-local-quit' in init function |
|
119 |
;; Issue #1521. |
|
120 |
(helm-force-update |
|
121 |
(cl-ecase helm-top-poll-preselection |
|
122 |
(candidate (replace-regexp-in-string |
|
123 |
"[0-9]+" "[0-9]+" |
|
124 |
(regexp-quote (helm-get-selection nil t)))) |
|
125 |
(linum `(lambda () |
|
126 |
(goto-char (point-min)) |
|
127 |
(forward-line ,(helm-candidate-number-at-point))))))) |
|
128 |
(setq helm-top--poll-timer |
|
129 |
(run-with-idle-timer |
|
130 |
(helm-aif (current-idle-time) |
|
131 |
(time-add it (seconds-to-time |
|
132 |
(or delay (helm-top--poll-delay)))) |
|
133 |
(or delay (helm-top--poll-delay))) |
|
134 |
nil |
|
135 |
'helm-top-poll))) |
|
136 |
(quit (cancel-timer helm-top--poll-timer)))) |
|
137 |
|
|
138 |
(defun helm-top--poll-delay () |
|
139 |
(max 1.5 helm-top-poll-delay)) |
|
140 |
|
|
141 |
(defun helm-top-poll-no-update () |
|
142 |
(helm-top-poll t (+ (helm-top--poll-delay) |
|
143 |
helm-top-poll-delay-post-command))) |
|
144 |
|
|
145 |
(defun helm-top-initialize-poll-hooks () |
|
146 |
;; When emacs is idle during say 20s |
|
147 |
;; the idle timer will run in 20+1.5 s. |
|
148 |
;; This is fine when emacs stays idle, because the next timer |
|
149 |
;; will run at 21.5+1.5 etc... so the display will be updated |
|
150 |
;; at every 1.5 seconds. |
|
151 |
;; But as soon as emacs looses its idleness, the next update |
|
152 |
;; will occur at say 21+1.5 s, so we have to reinitialize |
|
153 |
;; the timer at 0+1.5. |
|
154 |
(add-hook 'post-command-hook 'helm-top-poll-no-update) |
|
155 |
(add-hook 'focus-in-hook 'helm-top-poll-no-update)) |
|
156 |
|
|
157 |
;;;###autoload |
|
158 |
(define-minor-mode helm-top-poll-mode |
|
159 |
"Refresh automatically helm top buffer once enabled." |
|
160 |
:group 'helm-top |
|
161 |
:global t |
|
162 |
(if helm-top-poll-mode |
|
163 |
(progn |
|
164 |
(add-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) |
|
165 |
(add-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks)) |
|
166 |
(remove-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) |
|
167 |
(remove-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks))) |
|
168 |
|
|
169 |
(defvar helm-source-top |
|
170 |
(helm-build-in-buffer-source "Top" |
|
171 |
:header-name (lambda (name) |
|
172 |
(concat name (if helm-top-poll-mode |
|
173 |
" (auto updating)" |
|
174 |
" (Press C-c C-u to refresh)"))) |
|
175 |
:init #'helm-top-init |
|
176 |
:after-init-hook 'helm-top-after-init-hook |
|
177 |
:cleanup (lambda () |
|
178 |
(when helm-top--poll-timer |
|
179 |
(cancel-timer helm-top--poll-timer)) |
|
180 |
(remove-hook 'post-command-hook 'helm-top-poll-no-update) |
|
181 |
(remove-hook 'focus-in-hook 'helm-top-poll-no-update)) |
|
182 |
:display-to-real #'helm-top-display-to-real |
|
183 |
:persistent-action '(helm-top-sh-persistent-action . never-split) |
|
184 |
:persistent-help "SIGTERM" |
|
185 |
:help-message 'helm-top-help-message |
|
186 |
:mode-line 'helm-top-mode-line |
|
187 |
:follow 'never |
|
188 |
:keymap helm-top-map |
|
189 |
:filtered-candidate-transformer #'helm-top-sort-transformer |
|
190 |
:action-transformer #'helm-top-action-transformer |
|
191 |
:group 'helm-sys)) |
|
192 |
|
|
193 |
(defvar helm-top--line nil) |
|
194 |
(defun helm-top-transformer (candidates _source) |
|
195 |
"Transformer for `helm-top'. |
|
196 |
Return empty string for non--valid candidates." |
|
197 |
(cl-loop for disp in candidates collect |
|
198 |
(cond ((string-match "^ *[0-9]+" disp) disp) |
|
199 |
((string-match "^ *PID" disp) |
|
200 |
(setq helm-top--line (cons (propertize disp 'face 'helm-top-columns) ""))) |
|
201 |
(t (cons disp ""))) |
|
202 |
into lst |
|
203 |
finally return (or (member helm-top--line lst) |
|
204 |
(cons helm-top--line lst)))) |
|
205 |
|
|
206 |
(defun helm-top--skip-top-line () |
|
207 |
(let* ((src (helm-get-current-source)) |
|
208 |
(src-name (assoc-default 'name src))) |
|
209 |
(helm-aif (and (stringp src-name) |
|
210 |
(string= src-name "Top") |
|
211 |
(helm-get-selection nil t src)) |
|
212 |
(when (string-match-p "^ *PID" it) |
|
213 |
(helm-next-line))))) |
|
214 |
|
|
215 |
(defun helm-top-action-transformer (actions _candidate) |
|
216 |
"Action transformer for `top'. |
|
217 |
Show actions only on line starting by a PID." |
|
218 |
(let ((disp (helm-get-selection nil t))) |
|
219 |
(cond ((string-match "\\` *[0-9]+" disp) |
|
220 |
(list '("kill (SIGTERM)" . (lambda (_pid) |
|
221 |
(helm-top-sh "TERM" (helm-top--marked-pids)))) |
|
222 |
'("kill (SIGKILL)" . (lambda (_pid) |
|
223 |
(helm-top-sh "KILL" (helm-top--marked-pids)))) |
|
224 |
'("kill (SIGINT)" . (lambda (_pid) |
|
225 |
(helm-top-sh "INT" (helm-top--marked-pids)))) |
|
226 |
'("kill (Choose signal)" |
|
227 |
. (lambda (_pid) |
|
228 |
(let ((pids (helm-top--marked-pids))) |
|
229 |
(helm-top-sh |
|
230 |
(helm-comp-read (format "Kill %d pids with signal: " |
|
231 |
(length pids)) |
|
232 |
'("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL" |
|
233 |
"PROF" "TERM" "USR1" "USR2" "VTALRM" |
|
234 |
"STKFLT" "PWR" "WINCH" "CHLD" "URG" |
|
235 |
"TSTP" "TTIN" "TTOU" "STOP" "CONT" |
|
236 |
"ABRT" "FPE" "ILL" "QUIT" "SEGV" |
|
237 |
"TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ") |
|
238 |
:must-match t) |
|
239 |
pids)))))) |
|
240 |
(t actions)))) |
|
241 |
|
|
242 |
(defun helm-top--marked-pids () |
|
243 |
(helm-remove-if-not-match "\\`[0-9]+\\'" (helm-marked-candidates))) |
|
244 |
|
|
245 |
(defun helm-top-sh (sig pids) |
|
246 |
"Run kill shell command with signal SIG on PIDS for `helm-top'." |
|
247 |
(message "kill -%s %s exited with status %s" |
|
248 |
sig (mapconcat 'identity pids " ") |
|
249 |
(apply #'call-process |
|
250 |
"kill" nil nil nil (format "-%s" sig) pids))) |
|
251 |
|
|
252 |
(defun helm-top-sh-persistent-action (pid) |
|
253 |
(helm-top-sh "TERM" (list pid)) |
|
254 |
(helm-delete-current-selection)) |
|
255 |
|
|
256 |
(defun helm-top-init () |
|
257 |
"Insert output of top command in candidate buffer." |
|
258 |
(with-local-quit |
|
259 |
(unless helm-top-sort-fn (helm-top-set-mode-line "CPU")) |
|
260 |
(with-current-buffer (helm-candidate-buffer 'global) |
|
261 |
(call-process-shell-command |
|
262 |
(format helm-top-command (frame-width)) |
|
263 |
nil (current-buffer))))) |
|
264 |
|
|
265 |
(defun helm-top-display-to-real (line) |
|
266 |
"Return pid only from LINE." |
|
267 |
(car (split-string line))) |
|
268 |
|
|
269 |
;; Sort top command |
|
270 |
|
|
271 |
(defun helm-top-set-mode-line (str) |
|
272 |
(if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line) |
|
273 |
(setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1)) |
|
274 |
(setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line)))) |
|
275 |
|
|
276 |
(defun helm-top-sort-transformer (candidates source) |
|
277 |
(helm-top-transformer |
|
278 |
(if helm-top-sort-fn |
|
279 |
(cl-loop for c in candidates |
|
280 |
if (string-match "^ *[0-9]+" c) |
|
281 |
collect c into pid-cands |
|
282 |
else collect c into header-cands |
|
283 |
finally return (append |
|
284 |
header-cands |
|
285 |
(sort pid-cands helm-top-sort-fn))) |
|
286 |
candidates) |
|
287 |
source)) |
|
288 |
|
|
289 |
(defun helm-top-sort-by-com (s1 s2) |
|
290 |
(let* ((split-1 (split-string s1)) |
|
291 |
(split-2 (split-string s2)) |
|
292 |
(col (cdr (assq 'com helm-top-sort-columns-alist))) |
|
293 |
(com-1 (nth col split-1)) |
|
294 |
(com-2 (nth col split-2))) |
|
295 |
(string< com-1 com-2))) |
|
296 |
|
|
297 |
(defun helm-top-sort-by-mem (s1 s2) |
|
298 |
(let* ((split-1 (split-string s1)) |
|
299 |
(split-2 (split-string s2)) |
|
300 |
(col (cdr (assq 'mem helm-top-sort-columns-alist))) |
|
301 |
(mem-1 (string-to-number (nth col split-1))) |
|
302 |
(mem-2 (string-to-number (nth col split-2)))) |
|
303 |
(> mem-1 mem-2))) |
|
304 |
|
|
305 |
(defun helm-top-sort-by-cpu (s1 s2) |
|
306 |
(let* ((split-1 (split-string s1)) |
|
307 |
(split-2 (split-string s2)) |
|
308 |
(col (cdr (assq 'cpu helm-top-sort-columns-alist))) |
|
309 |
(cpu-1 (string-to-number (nth col split-1))) |
|
310 |
(cpu-2 (string-to-number (nth col split-2)))) |
|
311 |
(> cpu-1 cpu-2))) |
|
312 |
|
|
313 |
(defun helm-top-sort-by-user (s1 s2) |
|
314 |
(let* ((split-1 (split-string s1)) |
|
315 |
(split-2 (split-string s2)) |
|
316 |
(col (cdr (assq 'user helm-top-sort-columns-alist))) |
|
317 |
(user-1 (nth col split-1)) |
|
318 |
(user-2 (nth col split-2))) |
|
319 |
(string< user-1 user-2))) |
|
320 |
|
|
321 |
(defun helm-top--preselect-fn () |
|
322 |
(if (eq helm-top-poll-preselection 'linum) |
|
323 |
`(lambda () |
|
324 |
(goto-char (point-min)) |
|
325 |
(forward-line ,(helm-candidate-number-at-point))) |
|
326 |
(replace-regexp-in-string |
|
327 |
"[0-9]+" "[0-9]+" |
|
328 |
(regexp-quote (helm-get-selection nil t))))) |
|
329 |
|
|
330 |
(defun helm-top-run-sort-by-com () |
|
331 |
(interactive) |
|
332 |
(helm-top-set-mode-line "COM") |
|
333 |
(setq helm-top-sort-fn 'helm-top-sort-by-com) |
|
334 |
(helm-update (helm-top--preselect-fn))) |
|
335 |
|
|
336 |
(defun helm-top-run-sort-by-cpu () |
|
337 |
(interactive) |
|
338 |
(helm-top-set-mode-line "CPU") |
|
339 |
;; Force sorting by CPU even if some versions of top are using by |
|
340 |
;; default CPU sorting (Issue #1908). |
|
341 |
(setq helm-top-sort-fn 'helm-top-sort-by-cpu) |
|
342 |
(helm-update (helm-top--preselect-fn))) |
|
343 |
|
|
344 |
(defun helm-top-run-sort-by-mem () |
|
345 |
(interactive) |
|
346 |
(helm-top-set-mode-line "MEM") |
|
347 |
(setq helm-top-sort-fn 'helm-top-sort-by-mem) |
|
348 |
(helm-update (helm-top--preselect-fn))) |
|
349 |
|
|
350 |
(defun helm-top-run-sort-by-user () |
|
351 |
(interactive) |
|
352 |
(helm-top-set-mode-line "USER") |
|
353 |
(setq helm-top-sort-fn 'helm-top-sort-by-user) |
|
354 |
(helm-update (helm-top--preselect-fn))) |
|
355 |
|
|
356 |
|
|
357 |
;;; X RandR resolution change |
|
358 |
;; |
|
359 |
;; |
|
360 |
;;; FIXME I do not care multi-display. |
|
361 |
|
|
362 |
(defun helm-xrandr-info () |
|
363 |
"Return a pair with current X screen number and current X display name." |
|
364 |
(with-temp-buffer |
|
365 |
(call-process "xrandr" nil (current-buffer) nil |
|
366 |
"--current") |
|
367 |
(let (screen output) |
|
368 |
(goto-char (point-min)) |
|
369 |
(save-excursion |
|
370 |
(when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t) |
|
371 |
(setq screen (match-string 2)))) |
|
372 |
(when (re-search-forward "^\\(.*\\) connected" nil t) |
|
373 |
(setq output (match-string 1))) |
|
374 |
(list screen output)))) |
|
375 |
|
|
376 |
(defun helm-xrandr-screen () |
|
377 |
"Return current X screen number." |
|
378 |
(car (helm-xrandr-info))) |
|
379 |
|
|
380 |
(defun helm-xrandr-output () |
|
381 |
"Return current X display name." |
|
382 |
(cadr (helm-xrandr-info))) |
|
383 |
|
|
384 |
(defvar helm-source-xrandr-change-resolution |
|
385 |
(helm-build-sync-source "Change Resolution" |
|
386 |
:candidates |
|
387 |
(lambda () |
|
388 |
(with-temp-buffer |
|
389 |
(call-process "xrandr" nil (current-buffer) nil |
|
390 |
"--screen" (helm-xrandr-screen) "-q") |
|
391 |
(goto-char 1) |
|
392 |
(cl-loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) |
|
393 |
for mode = (match-string 1) |
|
394 |
unless (member mode modes) |
|
395 |
collect mode into modes |
|
396 |
finally return modes))) |
|
397 |
:action |
|
398 |
(helm-make-actions "Change Resolution" |
|
399 |
(lambda (mode) |
|
400 |
(call-process "xrandr" nil nil nil |
|
401 |
"--screen" (helm-xrandr-screen) |
|
402 |
"--output" (helm-xrandr-output) |
|
403 |
"--mode" mode))))) |
|
404 |
|
|
405 |
|
|
406 |
;;; Emacs process |
|
407 |
;; |
|
408 |
;; |
|
409 |
(defvar helm-source-emacs-process |
|
410 |
(helm-build-sync-source "Emacs Process" |
|
411 |
:init (lambda () |
|
412 |
(let (tabulated-list-use-header-line) |
|
413 |
(list-processes--refresh))) |
|
414 |
:candidates (lambda () (mapcar #'process-name (process-list))) |
|
415 |
:persistent-action (lambda (elm) |
|
416 |
(delete-process (get-process elm)) |
|
417 |
(helm-delete-current-selection)) |
|
418 |
:persistent-help "Kill Process" |
|
419 |
:action (helm-make-actions "Kill Process" |
|
420 |
(lambda (_elm) |
|
421 |
(cl-loop for p in (helm-marked-candidates) |
|
422 |
do (delete-process (get-process p))))))) |
|
423 |
|
|
424 |
|
|
425 |
;;;###autoload |
|
426 |
(defun helm-top () |
|
427 |
"Preconfigured `helm' for top command." |
|
428 |
(interactive) |
|
429 |
(add-hook 'helm-after-update-hook 'helm-top--skip-top-line) |
|
430 |
(save-window-excursion |
|
431 |
(unless helm-alive-p (delete-other-windows)) |
|
432 |
(unwind-protect |
|
433 |
(helm :sources 'helm-source-top |
|
434 |
:buffer "*helm top*" :full-frame t |
|
435 |
:candidate-number-limit 9999 |
|
436 |
:preselect "^\\s-*[0-9]+" |
|
437 |
:truncate-lines helm-show-action-window-other-window) |
|
438 |
(remove-hook 'helm-after-update-hook 'helm-top--skip-top-line)))) |
|
439 |
|
|
440 |
;;;###autoload |
|
441 |
(defun helm-list-emacs-process () |
|
442 |
"Preconfigured `helm' for emacs process." |
|
443 |
(interactive) |
|
444 |
(helm-other-buffer 'helm-source-emacs-process "*helm process*")) |
|
445 |
|
|
446 |
;;;###autoload |
|
447 |
(defun helm-xrandr-set () |
|
448 |
"Preconfigured helm for xrandr." |
|
449 |
(interactive) |
|
450 |
(helm :sources 'helm-source-xrandr-change-resolution |
|
451 |
:buffer "*helm xrandr*")) |
|
452 |
|
|
453 |
(provide 'helm-sys) |
|
454 |
|
|
455 |
;; Local Variables: |
|
456 |
;; byte-compile-warnings: (not obsolete) |
|
457 |
;; coding: utf-8 |
|
458 |
;; indent-tabs-mode: nil |
|
459 |
;; End: |
|
460 |
|
|
461 |
;;; helm-sys.el ends here |