316 lines
11 KiB
EmacsLisp
316 lines
11 KiB
EmacsLisp
|
;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*-
|
|||
|
|
|
|||
|
|
;; Copyright (C) 2012 ~ 2016 Thierry Volpiatto <thierry.volpiatto@gmail.com>
|
|||
|
|
|
|||
|
|
;; This program is free software; you can redistribute it and/or modify
|
|||
|
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|||
|
|
;; (at your option) any later version.
|
|||
|
|
|
|||
|
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
|
;; GNU General Public License for more details.
|
|||
|
|
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'cl-lib)
|
|||
|
|
(require 'helm)
|
|||
|
|
(require 'helm-help)
|
|||
|
|
(require 'helm-utils)
|
|||
|
|
|
|||
|
|
|
|||
|
|
(defgroup helm-sys nil
|
|||
|
|
"System related helm library."
|
|||
|
|
:group 'helm)
|
|||
|
|
|
|||
|
|
(defface helm-top-columns
|
|||
|
|
'((t :inherit helm-header))
|
|||
|
|
"Face for helm help string in minibuffer."
|
|||
|
|
:group 'helm-sys)
|
|||
|
|
|
|||
|
|
|
|||
|
|
(defun helm-top-command-set-fn (var _value)
|
|||
|
|
(set var
|
|||
|
|
(cl-case system-type
|
|||
|
|
(darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start,vsz,%%cpu,%%mem,etime,command")
|
|||
|
|
(t "env COLUMNS=%s top -b -n 1"))))
|
|||
|
|
|
|||
|
|
(defcustom helm-top-command "env COLUMNS=%s top -b -n 1"
|
|||
|
|
"Top command used to display output of top.
|
|||
|
|
To use top command, a version supporting batch mode (-b option) is needed.
|
|||
|
|
On Mac OSX top command doesn't support this, so ps command
|
|||
|
|
is used by default instead.
|
|||
|
|
If you modify this the number and order of elements displayed
|
|||
|
|
should be the same as top command to have the sort commands
|
|||
|
|
working properly, that is 12 elements with the 2 first being
|
|||
|
|
PID and USER and the last 4 being %CPU, %MEM, TIME and COMMAND.
|
|||
|
|
A format string where %s will be replaced with `frame-width'."
|
|||
|
|
:group 'helm-sys
|
|||
|
|
:type 'string
|
|||
|
|
:set 'helm-top-command-set-fn)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Top (process)
|
|||
|
|
;;
|
|||
|
|
;;
|
|||
|
|
(defvar helm-top-sort-fn nil)
|
|||
|
|
(defvar helm-top-map
|
|||
|
|
(let ((map (make-sparse-keymap)))
|
|||
|
|
(set-keymap-parent map helm-map)
|
|||
|
|
(define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu)
|
|||
|
|
(define-key map (kbd "M-C") 'helm-top-run-sort-by-com)
|
|||
|
|
(define-key map (kbd "M-M") 'helm-top-run-sort-by-mem)
|
|||
|
|
(define-key map (kbd "M-U") 'helm-top-run-sort-by-user)
|
|||
|
|
map))
|
|||
|
|
|
|||
|
|
(defvar helm-source-top
|
|||
|
|
(helm-build-in-buffer-source "Top"
|
|||
|
|
:header-name (lambda (name) (concat name " (Press C-c C-u to refresh)"))
|
|||
|
|
:init #'helm-top-init
|
|||
|
|
:nomark t
|
|||
|
|
:display-to-real #'helm-top-display-to-real
|
|||
|
|
:persistent-action #'helm-top-sh-persistent-action
|
|||
|
|
:persistent-help "SIGTERM"
|
|||
|
|
:help-message 'helm-top-help-message
|
|||
|
|
:follow 'never
|
|||
|
|
:keymap helm-top-map
|
|||
|
|
:filtered-candidate-transformer #'helm-top-sort-transformer
|
|||
|
|
:action-transformer #'helm-top-action-transformer))
|
|||
|
|
|
|||
|
|
(defvar helm-top--line nil)
|
|||
|
|
(defun helm-top-transformer (candidates _source)
|
|||
|
|
"Transformer for `helm-top'.
|
|||
|
|
Return empty string for non--valid candidates."
|
|||
|
|
(cl-loop for disp in candidates collect
|
|||
|
|
(cond ((string-match "^ *[0-9]+" disp) disp)
|
|||
|
|
((string-match "^ *PID" disp)
|
|||
|
|
(setq helm-top--line (cons (propertize disp 'face 'helm-top-columns) "")))
|
|||
|
|
(t (cons disp "")))
|
|||
|
|
into lst
|
|||
|
|
finally return (or (member helm-top--line lst)
|
|||
|
|
(cons helm-top--line lst))))
|
|||
|
|
|
|||
|
|
(defun helm-top--skip-top-line ()
|
|||
|
|
(let ((src-name (assoc-default 'name (helm-get-current-source))))
|
|||
|
|
(helm-aif (and (stringp src-name)
|
|||
|
|
(string= src-name "Top")
|
|||
|
|
(helm-get-selection nil t))
|
|||
|
|
(when (string-match-p "^ *PID" it)
|
|||
|
|
(helm-next-line)))))
|
|||
|
|
|
|||
|
|
(defun helm-top-action-transformer (actions _candidate)
|
|||
|
|
"Action transformer for `top'.
|
|||
|
|
Show actions only on line starting by a PID."
|
|||
|
|
(let ((disp (helm-get-selection nil t)))
|
|||
|
|
(cond ((string-match "^ *[0-9]+" disp)
|
|||
|
|
(list '("kill (SIGTERM)" . (lambda (pid) (helm-top-sh "TERM" pid)))
|
|||
|
|
'("kill (SIGKILL)" . (lambda (pid) (helm-top-sh "KILL" pid)))
|
|||
|
|
'("kill (SIGINT)" . (lambda (pid) (helm-top-sh "INT" pid)))
|
|||
|
|
'("kill (Choose signal)"
|
|||
|
|
. (lambda (pid)
|
|||
|
|
(helm-top-sh
|
|||
|
|
(helm-comp-read (format "Kill [%s] with signal: " pid)
|
|||
|
|
'("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL"
|
|||
|
|
"PROF" "TERM" "USR1" "USR2" "VTALRM"
|
|||
|
|
"STKFLT" "PWR" "WINCH" "CHLD" "URG"
|
|||
|
|
"TSTP" "TTIN" "TTOU" "STOP" "CONT"
|
|||
|
|
"ABRT" "FPE" "ILL" "QUIT" "SEGV"
|
|||
|
|
"TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ")
|
|||
|
|
:must-match t)
|
|||
|
|
pid)))))
|
|||
|
|
(t actions))))
|
|||
|
|
|
|||
|
|
(defun helm-top-sh (sig pid)
|
|||
|
|
"Run kill shell command with signal SIG on PID for `helm-top'."
|
|||
|
|
(let ((cmd (format "kill -%s %s" sig pid)))
|
|||
|
|
(message "Executed %s\n%s" cmd (shell-command-to-string cmd))))
|
|||
|
|
|
|||
|
|
(defun helm-top-sh-persistent-action (pid)
|
|||
|
|
(delete-other-windows)
|
|||
|
|
(helm-top-sh "TERM" pid)
|
|||
|
|
(helm-force-update))
|
|||
|
|
|
|||
|
|
(defun helm-top-init ()
|
|||
|
|
"Insert output of top command in candidate buffer."
|
|||
|
|
(unless helm-top-sort-fn (helm-top-set-mode-line "CPU"))
|
|||
|
|
(with-current-buffer (helm-candidate-buffer 'global)
|
|||
|
|
(call-process-shell-command
|
|||
|
|
(format helm-top-command (frame-width))
|
|||
|
|
nil (current-buffer))))
|
|||
|
|
|
|||
|
|
(defun helm-top-display-to-real (line)
|
|||
|
|
"Return pid only from LINE."
|
|||
|
|
(car (split-string line)))
|
|||
|
|
|
|||
|
|
;; Sort top command
|
|||
|
|
|
|||
|
|
(defun helm-top-set-mode-line (str)
|
|||
|
|
(if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line)
|
|||
|
|
(setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1))
|
|||
|
|
(setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line))))
|
|||
|
|
|
|||
|
|
(defun helm-top-sort-transformer (candidates source)
|
|||
|
|
(helm-top-transformer
|
|||
|
|
(if helm-top-sort-fn
|
|||
|
|
(cl-loop for c in candidates
|
|||
|
|
if (string-match "^ *[0-9]+" c)
|
|||
|
|
collect c into pid-cands
|
|||
|
|
else collect c into header-cands
|
|||
|
|
finally return (append
|
|||
|
|
header-cands
|
|||
|
|
(sort pid-cands helm-top-sort-fn)))
|
|||
|
|
candidates)
|
|||
|
|
source))
|
|||
|
|
|
|||
|
|
(defun helm-top-sort-by-com (s1 s2)
|
|||
|
|
(let* ((split-1 (split-string s1))
|
|||
|
|
(split-2 (split-string s2))
|
|||
|
|
(com-1 (nth 11 split-1))
|
|||
|
|
(com-2 (nth 11 split-2)))
|
|||
|
|
(string< com-1 com-2)))
|
|||
|
|
|
|||
|
|
(defun helm-top-sort-by-mem (s1 s2)
|
|||
|
|
(let* ((split-1 (split-string s1))
|
|||
|
|
(split-2 (split-string s2))
|
|||
|
|
(mem-1 (string-to-number (nth 9 split-1)))
|
|||
|
|
(mem-2 (string-to-number (nth 9 split-2))))
|
|||
|
|
(> mem-1 mem-2)))
|
|||
|
|
|
|||
|
|
(defun helm-top-sort-by-user (s1 s2)
|
|||
|
|
(let* ((split-1 (split-string s1))
|
|||
|
|
(split-2 (split-string s2))
|
|||
|
|
(user-1 (nth 1 split-1))
|
|||
|
|
(user-2 (nth 1 split-2)))
|
|||
|
|
(string< user-1 user-2)))
|
|||
|
|
|
|||
|
|
(defun helm-top-run-sort-by-com ()
|
|||
|
|
(interactive)
|
|||
|
|
(helm-top-set-mode-line "COM")
|
|||
|
|
(setq helm-top-sort-fn 'helm-top-sort-by-com)
|
|||
|
|
(helm-force-update))
|
|||
|
|
|
|||
|
|
(defun helm-top-run-sort-by-cpu ()
|
|||
|
|
(interactive)
|
|||
|
|
(helm-top-set-mode-line "CPU")
|
|||
|
|
(setq helm-top-sort-fn nil)
|
|||
|
|
(helm-force-update))
|
|||
|
|
|
|||
|
|
(defun helm-top-run-sort-by-mem ()
|
|||
|
|
(interactive)
|
|||
|
|
(helm-top-set-mode-line "MEM")
|
|||
|
|
(setq helm-top-sort-fn 'helm-top-sort-by-mem)
|
|||
|
|
(helm-force-update))
|
|||
|
|
|
|||
|
|
(defun helm-top-run-sort-by-user ()
|
|||
|
|
(interactive)
|
|||
|
|
(helm-top-set-mode-line "USER")
|
|||
|
|
(setq helm-top-sort-fn 'helm-top-sort-by-user)
|
|||
|
|
(helm-force-update))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; X RandR resolution change
|
|||
|
|
;;
|
|||
|
|
;;
|
|||
|
|
;;; FIXME I do not care multi-display.
|
|||
|
|
|
|||
|
|
(defun helm-xrandr-info ()
|
|||
|
|
"Return a pair with current X screen number and current X display name."
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(call-process "xrandr" nil (current-buffer) nil
|
|||
|
|
"--current")
|
|||
|
|
(let (screen output)
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(save-excursion
|
|||
|
|
(when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
|
|||
|
|
(setq screen (match-string 2))))
|
|||
|
|
(when (re-search-forward "^\\(.*\\) connected" nil t)
|
|||
|
|
(setq output (match-string 1)))
|
|||
|
|
(list screen output))))
|
|||
|
|
|
|||
|
|
(defun helm-xrandr-screen ()
|
|||
|
|
"Return current X screen number."
|
|||
|
|
(car (helm-xrandr-info)))
|
|||
|
|
|
|||
|
|
(defun helm-xrandr-output ()
|
|||
|
|
"Return current X display name."
|
|||
|
|
(cadr (helm-xrandr-info)))
|
|||
|
|
|
|||
|
|
(defvar helm-source-xrandr-change-resolution
|
|||
|
|
'((name . "Change Resolution")
|
|||
|
|
(candidates
|
|||
|
|
. (lambda ()
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(call-process "xrandr" nil (current-buffer) nil
|
|||
|
|
"--screen" (helm-xrandr-screen) "-q")
|
|||
|
|
(goto-char 1)
|
|||
|
|
(cl-loop with modes = nil
|
|||
|
|
while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
|
|||
|
|
for mode = (match-string 1)
|
|||
|
|
unless (member mode modes)
|
|||
|
|
collect mode into modes
|
|||
|
|
finally return modes))))
|
|||
|
|
(action
|
|||
|
|
("Change Resolution"
|
|||
|
|
. (lambda (mode)
|
|||
|
|
(call-process "xrandr" nil nil nil
|
|||
|
|
"--screen" (helm-xrandr-screen)
|
|||
|
|
"--output" (helm-xrandr-output)
|
|||
|
|
"--mode" mode))))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Emacs process
|
|||
|
|
;;
|
|||
|
|
;;
|
|||
|
|
(defvar helm-source-emacs-process
|
|||
|
|
'((name . "Emacs Process")
|
|||
|
|
(init . (lambda () (list-processes--refresh)))
|
|||
|
|
(candidates . (lambda () (mapcar #'process-name (process-list))))
|
|||
|
|
(persistent-action . (lambda (elm)
|
|||
|
|
(delete-process (get-process elm))
|
|||
|
|
(helm-delete-current-selection)))
|
|||
|
|
(persistent-help . "Kill Process")
|
|||
|
|
(action ("Kill Process" . (lambda (elm)
|
|||
|
|
(delete-process (get-process elm)))))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defun helm-top ()
|
|||
|
|
"Preconfigured `helm' for top command."
|
|||
|
|
(interactive)
|
|||
|
|
(add-hook 'helm-after-update-hook 'helm-top--skip-top-line)
|
|||
|
|
(save-window-excursion
|
|||
|
|
(unless helm-alive-p (delete-other-windows))
|
|||
|
|
(unwind-protect
|
|||
|
|
(helm :sources 'helm-source-top
|
|||
|
|
:buffer "*helm top*" :full-frame t
|
|||
|
|
:candidate-number-limit 9999
|
|||
|
|
:preselect "^\\s-*[0-9]+")
|
|||
|
|
(remove-hook 'helm-after-update-hook 'helm-top--skip-top-line))))
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defun helm-list-emacs-process ()
|
|||
|
|
"Preconfigured `helm' for emacs process."
|
|||
|
|
(interactive)
|
|||
|
|
(helm-other-buffer 'helm-source-emacs-process "*helm process*"))
|
|||
|
|
|
|||
|
|
;;;###autoload
|
|||
|
|
(defun helm-xrandr-set ()
|
|||
|
|
"Preconfigured helm for xrandr."
|
|||
|
|
(interactive)
|
|||
|
|
(helm :sources 'helm-source-xrandr-change-resolution
|
|||
|
|
:buffer "*helm xrandr*"))
|
|||
|
|
|
|||
|
|
(provide 'helm-sys)
|
|||
|
|
|
|||
|
|
;; Local Variables:
|
|||
|
|
;; byte-compile-warnings: (not cl-functions obsolete)
|
|||
|
|
;; coding: utf-8
|
|||
|
|
;; indent-tabs-mode: nil
|
|||
|
|
;; End:
|
|||
|
|
|
|||
|
|
;;; helm-sys.el ends here
|