From 362bf56ec5e3fcef3278f633adbe03c6af5893f2 Mon Sep 17 00:00:00 2001 From: Laurence Warne Date: Wed, 16 Nov 2022 14:32:44 +0000 Subject: [PATCH] Add colors to proced Add a new custom variable proced-enable-color-flag which when set to a non-nil value (defaults to nil), will prompt some format functions to furnish their respective process attributes with colors and effects in order to make them easier to distinguish and highlight possible issues (e.g. high memory usage), in a manner similar to htop. In particular, the current Emacs process id is highlighted purple in both the process id and parent process id columns, session leaders have their process ids underlined, larger memory sizes for rss and vsize are highlighted in darker shades of orange, and the first word in the args property (the executable) is highlighted in blue. * lisp/proced.el (proced-grammar-alist): update to use new format functions (proced-low-memory-usage-threshold): new custom variable to determine whether a value represents 'low' memory usage, used only in proced-format-memory for coloring (proced-medium-memory-usage-threshold): new custom variable to determine whether a value represents 'medium' memory usage, used only in proced-format-memory for coloring (proced-enable-color-flag): new custom variable to toggle coloring (proced-run-status-code): new face (proced-interruptible-sleep-status-code): new face (proced-uninterruptible-sleep-status-code): new face (proced-executable): new face (proced-memory-gb): new face (proced-memory-mb): new face (proced-memory-default): new face (proced-pid): new face (proced-ppid): new face (proced-pgrp): new face (proced-sess): new face (proced-cpu): new face (proced-mem): new face (proced-user): new face (proced-time-colon): new face (proced-format-time): edit function to color colons using proced-time-colon (proced-format-args): edit function to color executables using proced-executable (proced-format-state): new function to color states (proced-format-pid): new function to color process ids (proced-format-ppid): new function to color parent process ids (proced-format-pgrp): new function to color process group ids (proced-format-sess): new function to color process session leader ids (proced-format-cpu): new function to color cpu utilization (proced-format-mem): new function to color memory utilization (proced-format-user): new function to color the user a process belongs to --- lisp/proced.el | 223 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 207 insertions(+), 16 deletions(-) diff --git a/lisp/proced.el b/lisp/proced.el index a6f1a71778..caee4de5e6 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -114,16 +114,16 @@ proced-signal-list (defcustom proced-grammar-alist '( ;; attributes defined in `process-attributes' (euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil)) - (user "User" nil left proced-string-lessp nil (user pid) (nil t nil)) + (user "User" proced-format-user left proced-string-lessp nil (user pid) (nil t nil)) (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) (group "Group" nil left proced-string-lessp nil (group user pid) (nil t nil)) (comm "Command" nil left proced-string-lessp nil (comm pid) (nil t nil)) - (state "Stat" nil left proced-string-lessp nil (state pid) (nil t nil)) - (ppid "PPID" "%d" right proced-< nil (ppid pid) + (state "Stat" proced-format-state left proced-string-lessp nil (state pid) (nil t nil)) + (ppid "PPID" proced-format-ppid right proced-< nil (ppid pid) ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) "refine to process parents")) - (pgrp "PGrp" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) - (sess "Sess" "%d" right proced-< nil (sess pid) (nil t nil)) + (pgrp "PGrp" proced-format-pgrp right proced-< nil (pgrp euid pid) (nil t nil)) + (sess "Sess" proced-format-sess right proced-< nil (sess pid) (nil t nil)) (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) (tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil)) (minflt "MinFlt" "%d" right proced-< nil (minflt pid) (nil t t)) @@ -143,12 +143,12 @@ proced-grammar-alist (vsize "VSize" proced-format-memory right proced-< t (vsize pid) (nil t t)) (rss "RSS" proced-format-memory right proced-< t (rss pid) (nil t t)) (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) - (pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t)) - (pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t)) + (pcpu "%CPU" proced-format-cpu right proced-< t (pcpu pid) (nil t t)) + (pmem "%Mem" proced-format-mem right proced-< t (pmem pid) (nil t t)) (args "Args" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) ;; ;; attributes defined by proced (see `proced-process-attributes') - (pid "PID" "%d" right proced-< nil (pid) + (pid "PID" proced-format-pid right proced-< nil (pid) ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) "refine to process children")) ;; process tree @@ -367,6 +367,30 @@ proced-after-send-signal-hook :type 'hook :options '(proced-revert)) +(defcustom proced-enable-color-flag nil + "Non-nil means some process attributes will be rendered with color." + :type 'boolean + :version "29.1") + +(defcustom proced-low-memory-usage-threshold (* 1024 1024 100) + "The low memory usage (in bytes) upper bound. + +When `proced-enable-color-flag' is non-nil, vsize and rss values less than +this value will be rendered using the `proced-memory-low-usage' face." + :type 'integer + :version "29.1") + +(defcustom proced-medium-memory-usage-threshold (* 1024 1024 1024) + "The medium memory usage (in bytes) upper bound. + +When `proced-enable-color-flag' is non-nil, vsize and rss values less than +this value, but greater than `proced-low-memory-usage-threshold' will be +rendered using the `proced-memory-medium-usage' face. vsize and rss values +greater than this value will be rendered using the `proced-memory-high-usage' +face." + :type 'integer + :version "29.1") + ;; Internal variables (defvar proced-available t;(not (null (list-system-processes))) @@ -403,6 +427,91 @@ proced-sort-header '((t (:inherit font-lock-keyword-face))) "Face used for header of attribute used for sorting.") +(defface proced-run-status-code + '((t (:foreground "green"))) + "Face used for the running or runnable status code character \"R\"." + :version "29.1") + +(defface proced-interruptible-sleep-status-code + '((t (:foreground "DimGrey"))) + "Face used for the interruptible sleep status code character \"S\"." + :version "29.1") + +(defface proced-uninterruptible-sleep-status-code + '((t (:foreground "red"))) + "Face used for the uninterruptible sleep status code character \"D\"." + :version "29.1") + +(defface proced-executable + '((t (:foreground "DeepSkyBlue"))) + "Face for executables (first word in the args process attribute)." + :version "29.1") + +(defface proced-memory-high-usage + '((t (:foreground "orange"))) + "Face for high memory usage." + :version "29.1") + +(defface proced-memory-medium-usage + '((t (:foreground "#ded93e"))) + "Face for medium memory usage." + :version "29.1") + +(defface proced-memory-low-usage + '((t (:foreground "#8bcd50"))) + "Face for low memory usage." + :version "29.1") + +(defface proced-emacs-pid + '((t (:foreground "purple"))) + "Face for the pid of the current Emacs process." + :version "29.1") + +(defface proced-pid + '((t (:foreground "#5085ef"))) + "Face for process ids." + :version "29.1") + +(defface proced-session-leader-pid + '((t (:foreground "#5085ef" :underline t))) + "Face for process ids which are session leaders." + :version "29.1") + +(defface proced-ppid + '((t (:foreground "#5085bf"))) + "Face for parent process ids." + :version "29.1") + +(defface proced-pgrp + '((t (:foreground "#4785bf"))) + "Face for process group ids." + :version "29.1") + +(defface proced-sess + '((t (:foreground "#41729f"))) + "Face for process session ids." + :version "29.1") + +(defface proced-cpu + '((t (:foreground "#6d5cc3" :bold t))) + "Face for process cpu utilization." + :version "29.1") + +(defface proced-mem + '((t (:foreground "#6d5cc3"))) + "Face for process memory utilization." + :version "29.1") + +(defface proced-user + '((t (:bold t))) + "Face for the user." + :version "29.1") + +(defface proced-time-colon + '((t (:foreground "DarkMagenta"))) + "Face for the colon in time strings." + :version "29.1") + (defvar proced-re-mark "^[^ \n]" "Regexp matching a marked line. Important: the match ends just after the marker.") @@ -1386,26 +1495,32 @@ proced-format-time (hours (truncate ftime 3600)) (ftime (mod ftime 3600)) (minutes (truncate ftime 60)) - (seconds (mod ftime 60))) + (seconds (mod ftime 60)) + (colon (if proced-enable-color-flag + (propertize ":" 'font-lock-face 'proced-time-colon) + ":"))) (cond ((< 0 days) - (format "%d-%02d:%02d:%02d" days hours minutes seconds)) + (format "%d-%02d%3$s%02d%3$s%02d" days hours colon minutes seconds)) ((< 0 hours) - (format "%02d:%02d:%02d" hours minutes seconds)) + (format "%02d%2$s%02d%2$s%02d" hours colon minutes seconds)) (t - (format "%02d:%02d" minutes seconds))))) + (format "%02d%s%02d" minutes colon seconds))))) (defun proced-format-start (start) "Format time START. The return string is always 6 characters wide." (let ((d-start (decode-time start)) - (d-current (decode-time))) + (d-current (decode-time)) + (colon (if proced-enable-color-flag + (propertize ":" 'font-lock-face 'proced-time-colon) + ":"))) (cond (;; process started in previous years (< (decoded-time-year d-start) (decoded-time-year d-current)) (format-time-string " %Y" start)) ;; process started today ((and (= (decoded-time-day d-start) (decoded-time-day d-current)) (= (decoded-time-month d-start) (decoded-time-month d-current))) - (format-time-string " %H:%M" start)) + (string-replace ":" colon (format-time-string " %H:%M" start))) (t ;; process started this year (format-time-string "%b %e" start))))) @@ -1423,11 +1538,87 @@ proced-format-tree (defun proced-format-args (args) "Format attribute ARGS. Replace newline characters by \"^J\" (two characters)." - (string-replace "\n" "^J" args)) + (string-replace "\n" "^J" + (pcase-let* ((`(,exe . ,rest) (split-string args)) + (exe-prop (if proced-enable-color-flag + (propertize exe 'font-lock-face 'proced-executable) + exe))) + (mapconcat #'identity (cons exe-prop rest) " ")))) (defun proced-format-memory (kilobytes) "Format KILOBYTES in a human readable format." - (funcall byte-count-to-string-function (* 1024 kilobytes))) + (let* ((bytes (* 1024 kilobytes)) + (formatted (funcall byte-count-to-string-function bytes))) + (cond ((and proced-enable-color-flag (< bytes proced-low-memory-usage-threshold)) + (propertize formatted 'font-lock-face 'proced-memory-low-usage)) + ((and proced-enable-color-flag (< bytes proced-medium-memory-usage-threshold)) + (propertize formatted 'font-lock-face 'proced-memory-medium-usage)) + (proced-enable-color-flag + (propertize formatted 'font-lock-face 'proced-memory-high-usage)) + (t formatted)))) + +(defun proced-format-state (state) + "Format STATE." + (cond ((and proced-enable-color-flag (string= state "R")) + (propertize state 'font-lock-face 'proced-run-status-code)) + ((and proced-enable-color-flag (string= state "S")) + (propertize state 'font-lock-face 'proced-interruptible-sleep-status-code)) + ((and proced-enable-color-flag (string= state "D")) + (propertize state 'font-lock-face 'proced-uninterruptible-sleep-status-code)) + (t state))) + +(defun proced-format-pid (pid) + "Format PID." + (let ((proc-info (process-attributes pid)) + (pid-s (number-to-string pid))) + (cond ((and proced-enable-color-flag (equal pid (emacs-pid))) + (propertize pid-s 'font-lock-face 'proced-emacs-pid)) + ((and proced-enable-color-flag (equal pid (alist-get 'sess proc-info))) + (propertize pid-s 'font-lock-face 'proced-session-leader-pid)) + (proced-enable-color-flag + (propertize pid-s 'font-lock-face 'proced-pid)) + (t pid-s)))) + +(defun proced-format-ppid (ppid) + "Format PPID." + (let ((ppid-s (number-to-string ppid))) + (cond ((and proced-enable-color-flag (= ppid (emacs-pid))) + (propertize ppid-s 'font-lock-face 'proced-emacs-pid)) + (proced-enable-color-flag + (propertize ppid-s 'font-lock-face 'proced-ppid)) + (t ppid-s)))) + +(defun proced-format-pgrp (pgrp) + "Format PGRP." + (if proced-enable-color-flag + (propertize (number-to-string pgrp) 'font-lock-face 'proced-pgrp) + (number-to-string pgrp))) + +(defun proced-format-sess (sess) + "Format SESS." + (if proced-enable-color-flag + (propertize (number-to-string sess) 'font-lock-face 'proced-sess) + (number-to-string sess))) + +(defun proced-format-cpu (cpu) + "Format CPU." + (let ((formatted (format "%.1f" cpu))) + (if proced-enable-color-flag + (propertize formatted 'font-lock-face 'proced-cpu) + formatted))) + +(defun proced-format-mem (mem) + "Format MEM." + (let ((formatted (format "%.1f" mem))) + (if proced-enable-color-flag + (propertize formatted 'font-lock-face 'proced-mem) + formatted))) + +(defun proced-format-user (user) + "Format USER." + (if proced-enable-color-flag + (propertize user 'font-lock-face 'proced-user) + user)) (defun proced-format (process-alist format) "Display PROCESS-ALIST using FORMAT." -- 2.30.2