Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

459 lines
17 KiB

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