bug#59407: [PATCH] Add Colors to proced

bug#59407: [PATCH] Add Colors to proced

[Laurence Warne]

[-- Attachment #1.1: Type: text/plain, Size: 713 bytes --]

Hi, attached is a patch I've recently been working to do with colorizing
proced buffers, similar to htop.

In particular, the current Emacs process id is highlighted purple in both
the process id and parent process id columns, session group 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 - I've attached a couple
of screenshots.

The way I'd recommend to try it out would be:

(require 'proced)
(setq-default proced-auto-update-flag t)
(setq-default proced-auto-update-interval 1)
(setq proced-enable-color-flag t)

And then M-x proced.

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 906 bytes --]

[-- Attachment #2: 0001-Add-colors-to-proced.patch --]
[-- Type: text/x-patch, Size: 14569 bytes --]

From 362bf56ec5e3fcef3278f633adbe03c6af5893f2 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
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


[-- Attachment #3: proced-colours-1.png --]
[-- Type: image/png, Size: 471177 bytes --]

[-- Attachment #4: proced-colours-2.png --]
[-- Type: image/png, Size: 349374 bytes --]

bug#59407: [PATCH] Add Colors to proced

[Eli Zaretskii]

> From: Laurence Warne <laurencewarne@gmail.com>
> Date: Sun, 20 Nov 2022 10:26:35 +0000
> 
> Hi, attached is a patch I've recently been working to do with colorizing proced buffers, similar to htop.
> 
> In particular, the current Emacs process id is highlighted purple in both the process id and parent process id
> columns, session group 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 - I've attached a couple of screenshots.

Thanks.  Please be sure to test the new faces with the following Emacs
configurations:

  . GUI frames with dark background
  . GUI frames with light background
  . TTY frames with dark and light backgrounds and with:
    - 8 colors
    - 16 colors

It is quite possible that some of the above combinations will not look well
with the colors you propose, and will need separate defaults.

A few more minor comments:

> * 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

This is not our style of commit log messages.  The description of each
change should begin with a capital letter and end with a period, i.e. be a
complete English sentence or several sentences.

> (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

It is better to have a single list of new faces with one description, like
this:

  (proced-run-status-code, proced-executable. proced-memory-default)
  (proced-memory-mb, proced-pgrp): New faces.

> +(defcustom proced-enable-color-flag nil
> +  "Non-nil means some process attributes will be rendered with color."

Please use "displayed", not "rendered".

> +(defcustom proced-low-memory-usage-threshold (* 1024 1024 100)
> +  "The low memory usage (in bytes) upper bound.

This should probably be specified as percentage of total memory.  Or maybe
there should be a separate defcustom for the percentage, and the condition
should use both.  Just a single absolute threshold seems to cover only some
reasons for highlighting processes with large memory footprint.

> +(defcustom proced-medium-memory-usage-threshold (* 1024 1024 1024)
> +  "The medium memory usage (in bytes) upper bound.

Likewise.

Finally, this changeset needs a suitable NEWS entry to announce it.

bug#59407: [PATCH] Add Colors to proced

[Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Laurence Warne <laurencewarne@gmail.com> writes:

> Hi, attached is a patch I've recently been working to do with
> colorizing proced buffers, similar to htop.
>
> In particular, the current Emacs process id is highlighted purple in
> both the process id and parent process id columns, session group
> 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 -
> I've attached a couple of screenshots.

Thanks, but what exactly is the purpose of this change?

The more colors that need to be allocated, the slower Emacs becomes over
a wide-area network.  In addition, every time a new color is used,
xfont_draw needs to be called again, generating more network traffic.

Emacs has already become quite slow over a network connection (though
this should have become significantly better in Emacs 29.)

Adding "eye candy" where it is not really necessary will only be a step
backwards.

> (require 'proced)
> (setq-default proced-auto-update-flag t)
> (setq-default proced-auto-update-interval 1)
> (setq proced-enable-color-flag t)

I guess if it is off by default, then I have no objections.  But I
respectfully ask everyone to keep in mind the network impact of changes
they make to Emacs.

bug#59407: [PATCH] Add Colors to proced

[Michael Albinus]

Laurence Warne <laurencewarne@gmail.com> writes:

> Hi,

Hi Laurence,

> attached is a patch I've recently been working to do with
> colorizing proced buffers, similar to htop.

I haven't tried your patch, but I'm curious whether it works also for
proced buffers of remote systems.

> In particular, the current Emacs process id is highlighted purple in
> both the process id and parent process id columns,

This should happen only for proced running on the local system.

> Thanks, Laurence

Best regards, Michael.

bug#59407: [PATCH] Add Colors to proced

[Eli Zaretskii]

> Cc: 59407@debbugs.gnu.org
> Date: Sun, 20 Nov 2022 20:33:59 +0800
> From:  Po Lu via "Bug reports for GNU Emacs,
>  the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
> 
> I guess if it is off by default, then I have no objections.

Yes, it is off by default, so will affect only users who turn it on.

bug#59407: [PATCH] Add Colors to proced

[Laurence Warne]

[-- Attachment #1.1: Type: text/plain, Size: 1965 bytes --]

Thanks for all the feedback, I have a few queries.

> Thanks.  Please be sure to test the new faces with the following Emacs
> configurations:
>
>   . GUI frames with dark background
>   . GUI frames with light background
>   . TTY frames with dark and light backgrounds and with:
>     - 8 colors
>     - 16 colors
>

Do you know if there's an easy way I can test the faces on 8/16 colour
terminals?

>   (proced-run-status-code, proced-executable. proced-memory-default)
>   (proced-memory-mb, proced-pgrp): New faces.
>
Minor, but do you mean to add a closing paren at the end of each line?  I
saw this format in the commit log:
  (proced-run-status-code, proced-executable. proced-memory-default,
  proced-memory-mb, proced-pgrp): New faces.

This should probably be specified as percentage of total memory.  Or maybe
> there should be a separate defcustom for the percentage, and the condition
> should use both.  Just a single absolute threshold seems to cover only some
> reasons for highlighting processes with large memory footprint.
>

I was thinking highlighting based on percentage memory would be more suited
to the "mem" process attribute (granted though this is not implemented).
Though in hindsight a global threshold may not make sense if you're
connecting to remote systems with varying amounts of RAM.  Perhaps the two
thresholds could mark a percentage, say 10% and 50% of total memory?

I haven't tried your patch, but I'm curious whether it works also for
> proced buffers of remote systems.
>
Hi Michael, I did a quick check yesterday and it seemed to work as expected.

This should happen only for proced running on the local system.
>
Thanks, this should be fixed in the most recent patch.

I've attached a more up to date patch, with changes to faces (mainly adding
better defaults for light backgrounds), and a NEWS entry.  Also attached
are images showing the current colour schemes on light backgrounds and
terminals.

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 3024 bytes --]

[-- Attachment #2: proced-colors-light-1.png --]
[-- Type: image/png, Size: 355474 bytes --]

[-- Attachment #3: proced-colors-terminal-dark.png --]
[-- Type: image/png, Size: 333988 bytes --]

[-- Attachment #4: proced-terminal-light.png --]
[-- Type: image/png, Size: 323526 bytes --]

[-- Attachment #5: 0001-Add-colors-to-proced.patch --]
[-- Type: text/x-patch, Size: 16713 bytes --]

From a9494167cef53d6c25d224caa444560cd556dd23 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
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 the 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, proced-interruptible-sleep-status-code,
proced-uninterruptible-sleep-status-code, proced-executable,
proced-executable, proced-memory-gb, proced-memory-mb,
proced-memory-default, proced-pid, proced-ppid, proced-pgrp,
proced-sess, proced-cpu, proced-mem, proced-user, proced-time-colon):
New faces.
(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.
---
 etc/NEWS       |  16 ++++
 lisp/proced.el | 242 +++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 242 insertions(+), 16 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 4c7af3c276..e41bab14de 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -514,6 +514,22 @@ option) and can be set to nil to disable Just-in-time Lock mode.
 \f
 * Changes in Emacs 29.1
 
+---
+** New user option `proced-enable-color-flag` to enable coloring of proced buffers
+This option enables prompts 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.
+
+Note this option is disabled by default and needs setting to a non-nil
+value to take effect.
+
 +++
 ** New user option 'major-mode-remap-alist' to specify favorite major modes.
 This user option lets you remap the default modes (e.g. 'perl-mode' or
diff --git a/lisp/proced.el b/lisp/proced.el
index a6f1a71778..b6e0897638 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 displayed 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 displayed 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
+displayed using the `proced-memory-medium-usage' face.  vsize and rss values
+greater than this value will be displayed 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,106 @@ 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
+  '((((class color)) (:foreground "DimGrey"))
+    (t (:italic t)))
+  "Face used for the interruptible sleep status code character \"S\"."
+  :version "29.1")
+
+(defface proced-uninterruptible-sleep-status-code
+  '((((class color)) (:foreground "red"))
+    (t (:bold t)))
+  "Face used for the uninterruptible sleep status code character \"D\"."
+  :version "29.1")
+
+(defface proced-executable
+  '((((class color) (background dark)) (:foreground "DeepSkyBlue"))
+    (t (:foreground "blue")))
+  "Face for executables (first word in the args process attribute)."
+  :version "29.1")
+
+(defface proced-memory-high-usage
+  '((((class color) (background dark)) (:foreground "orange"))
+    (((class color) (background light)) (:foreground "OrangeRed"))
+    (t (:bold t)))
+  "Face for high memory usage."
+  :version "29.1")
+
+(defface proced-memory-medium-usage
+  '((((class color) (background dark)) (:foreground "yellow3"))
+    (((class color) (background light)) (:foreground "orange")))
+  "Face for medium memory usage."
+  :version "29.1")
+
+(defface proced-memory-low-usage
+  '((((background dark) (min-colors 88)) (:foreground "#8bcd50"))
+    (((class color) (background light)) (:foreground "green")))
+  "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
+  '((((class color) (min-colors 88)) (:foreground "#5085ef"))
+    (((class color)) (:foreground "blue")))
+  "Face for process ids."
+  :version "29.1")
+
+(defface proced-session-leader-pid
+  '((((class color) (min-colors 88)) (:foreground "#5085ef" :underline t))
+    (((class color)) (:foreground "blue" :underline t))
+    (t (:underline t)))
+  "Face for process ids which are session leaders."
+  :version "29.1")
+
+(defface proced-ppid
+  '((((class color) (min-colors 88)) (:foreground "#5085bf"))
+    (((class color)) (:foreground "blue")))
+  "Face for parent process ids."
+  :version "29.1")
+
+(defface proced-pgrp
+  '((((class color) (min-colors 88)) (:foreground "#4785bf"))
+    (((class color)) (:foreground "blue")))
+  "Face for process group ids."
+  :version "29.1")
+
+(defface proced-sess
+  '((((class color) (min-colors 88)) (:foreground "#41729f")))
+  "Face for process session ids."
+  :version "29.1")
+
+(defface proced-cpu
+  '((((class color) (min-colors 88)) (:foreground "#6d5cc3" :bold t))
+    (t (:bold t)))
+  "Face for process cpu utilization."
+  :version "29.1")
+
+(defface proced-mem
+  '((((class color) (min-colors 88))
+     (: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
+  '((((class color)) (:foreground "DarkMagenta"))
+    (t (:bold t)))
+  "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 +1510,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 +1553,91 @@ 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
+                (not (file-remote-p default-directory))
+                (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
+                (not (file-remote-p default-directory))
+                (= 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

bug#59407: [PATCH] Add Colors to proced

[Michael Albinus]

Laurence Warne <laurencewarne@gmail.com> writes:

> Hi Michael,

Hi Laurence,

> I did a quick check yesterday and it seemed to work as
> expected.
>
>     This should happen only for proced running on the local system.
>
> Thanks, this should be fixed in the most recent patch.

Thanks!

> Thanks, Laurence

Best regards, Michael.

bug#59407: [PATCH] Add Colors to proced

[Eli Zaretskii]

> From: Laurence Warne <laurencewarne@gmail.com>
> Date: Mon, 21 Nov 2022 09:07:59 +0000
> Cc: Po Lu <luangruo@yahoo.com>, 59407@debbugs.gnu.org, 
> 	Michael Albinus <michael.albinus@gmx.de>
> 
>  Thanks.  Please be sure to test the new faces with the following Emacs
>  configurations:
> 
>    . GUI frames with dark background
>    . GUI frames with light background
>    . TTY frames with dark and light backgrounds and with:
>      - 8 colors
>      - 16 colors
> 
> Do you know if there's an easy way I can test the faces on 8/16 colour terminals?

For 8 colors, invoke Emacs with "-nw --color".
For 16 colors, try --color=16, and if it doesn't work, try configuring xterm
for 16 colors, then invoke Emacs with -nw.

>    (proced-run-status-code, proced-executable. proced-memory-default)
>    (proced-memory-mb, proced-pgrp): New faces. 
> 
> Minor, but do you mean to add a closing paren at the end of each line?

Yes.  You can use the command "C-x 4 a" to format the log entries, it will
do this automatically if auto-fill is turned on.

> I saw this format in the commit log:
>   (proced-run-status-code, proced-executable. proced-memory-default,
>   proced-memory-mb, proced-pgrp): New faces.

This is wrong.

>  This should probably be specified as percentage of total memory.  Or maybe
>  there should be a separate defcustom for the percentage, and the condition
>  should use both.  Just a single absolute threshold seems to cover only some
>  reasons for highlighting processes with large memory footprint.
> 
> I was thinking highlighting based on percentage memory would be more suited to the "mem" process
> attribute (granted though this is not implemented).  Though in hindsight a global threshold may not make
> sense if you're connecting to remote systems with varying amounts of RAM.  Perhaps the two thresholds
> could mark a percentage, say 10% and 50% of total memory?

Something like that, yes.

Thanks.

bug#59407: [PATCH] Add Colors to proced

[Laurence Warne]

[-- Attachment #1.1: Type: text/plain, Size: 941 bytes --]

Hi,

I've attached a new patch, the changes this time are that the memory
thresholds now take a proportion rather than a fixed value, and some of the
face defaults have been improved to play nicer with 8 colour displays.

I've disabled the threshold highlighting for vsize since I don't really
think it makes sense: it represents more than just size in virtual memory +
size in RAM so I don't see a reasonable way to take it as a proportion
(though I don't think a fixed threshold makes sense either, so I've left it
unhighlighted).  Also, memory-info doesn't appear to take into account
working on remote systems like list-system-processes does, so I've also
disabled the threshold highlighting for proced connected to remote
machines.  Suggestions on this are welcome (:

I've attached a screenshot showing an 8 colour display, still figuring out
how I can get only 16 colours, I'll ping here again when I figure it out.

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 1150 bytes --]

[-- Attachment #2: proced-8-color-light.png --]
[-- Type: image/png, Size: 101575 bytes --]

[-- Attachment #3: 0001-Add-colors-to-proced.patch --]
[-- Type: text/x-patch, Size: 17567 bytes --]

From 56891cd255655315114c9b8be22c7217d48f3435 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
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
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 the 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, proced-interruptible-sleep-status-code)
(proced-uninterruptible-sleep-status-code, proced-executable)
(proced-executable, proced-memory-gb, proced-memory-mb)
(proced-memory-default, proced-pid, proced-ppid, proced-pgrp)
(proced-sess, proced-cpu, proced-mem, proced-user, proced-time-colon):
New faces.
(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.
---
 etc/NEWS       |  16 ++++
 lisp/proced.el | 255 +++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 255 insertions(+), 16 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 4c7af3c276..49bdf41910 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -514,6 +514,22 @@ option) and can be set to nil to disable Just-in-time Lock mode.
 \f
 * Changes in Emacs 29.1
 
+---
+** New user option `proced-enable-color-flag` to enable coloring of proced buffers
+This option enables prompts 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 are
+highlighted in darker shades of orange, and the first word in the
+args property (the executable) is highlighted in blue.
+
+Note this option is disabled by default and needs setting to a non-nil
+value to take effect.
+
 +++
 ** New user option 'major-mode-remap-alist' to specify favorite major modes.
 This user option lets you remap the default modes (e.g. 'perl-mode' or
diff --git a/lisp/proced.el b/lisp/proced.el
index a6f1a71778..73c74147cf 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))
@@ -141,14 +141,14 @@ proced-grammar-alist
     (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t))
     (start   "Start"   proced-format-start 6 proced-time-lessp nil (start pid) (t t nil))
     (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))
+    (rss     "RSS"     proced-format-rss 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,32 @@ proced-after-send-signal-hook
   :type 'hook
   :options '(proced-revert))
 
+(defcustom proced-enable-color-flag nil
+  "Non-nil means some process attributes will be displayed with color."
+  :type 'boolean
+  :version "29.1")
+
+(defcustom proced-low-memory-usage-threshold 0.1
+  "The upper bound proportion of total memory for low usage.
+
+When `proced-enable-color-flag' is non-nil, rss values denoting a proportion
+of memory lower than this value will be displayed using the
+`proced-memory-low-usage' face."
+  :type 'float
+  :version "29.1")
+
+(defcustom proced-medium-memory-usage-threshold 0.5
+  "The medium memory usage (in bytes) upper bound.
+
+When `proced-enable-color-flag' is non-nil, rss values denoting a proportion
+of memory less than this value, but greater than
+`proced-low-memory-usage-threshold' will be displayed using the
+`proced-memory-medium-usage' face.  rss values denoting a greater proportion
+than this value will be displayed using the `proced-memory-high-usage'
+face."
+  :type 'float
+  :version "29.1")
+
 ;; Internal variables
 
 (defvar proced-available t;(not (null (list-system-processes)))
@@ -403,6 +429,112 @@ 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
+  '((((class color)) (:foreground "DimGrey"))
+    (t (:italic t)))
+  "Face used for the interruptible sleep status code character \"S\"."
+  :version "29.1")
+
+(defface proced-uninterruptible-sleep-status-code
+  '((((class color)) (:foreground "red"))
+    (t (:bold t)))
+  "Face used for the uninterruptible sleep status code character \"D\"."
+  :version "29.1")
+
+(defface proced-executable
+  '((((class color) (min-colors 88) (background dark)) (:foreground "DeepSkyBlue"))
+    (((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light)) (:foreground "blue"))
+    (t (:bold t)))
+  "Face for executables (first word in the args process attribute)."
+  :version "29.1")
+
+(defface proced-memory-high-usage
+  '((((class color) (min-colors 88) (background dark)) (:foreground "orange"))
+    (((class color) (min-colors 88) (background light)) (:foreground "OrangeRed"))
+    (((class color)) (:foreground "red"))
+    (t (:underline t)))
+  "Face for high memory usage."
+  :version "29.1")
+
+(defface proced-memory-medium-usage
+  '((((class color) (min-colors 88) (background dark)) (:foreground "yellow3"))
+    (((class color) (min-colors 88) (background light)) (:foreground "orange"))
+    (((class color)) (:foreground "yellow")))
+  "Face for medium memory usage."
+  :version "29.1")
+
+(defface proced-memory-low-usage
+  '((((class color) (min-colors 88) (background dark)) (:foreground "#8bcd50"))
+    (((class color)) (:foreground "green")))
+  "Face for low memory usage."
+  :version "29.1")
+
+(defface proced-emacs-pid
+  '((((class color) (min-colors 88)) (:foreground "purple"))
+    (((class color)) (:foreground "magenta")))
+  "Face for the pid of the current Emacs process."
+  :version "29.1")
+
+(defface proced-pid
+  '((((class color) (min-colors 88)) (:foreground "#5085ef"))
+    (((class color)) (:foreground "blue")))
+  "Face for process ids."
+  :version "29.1")
+
+(defface proced-session-leader-pid
+  '((((class color) (min-colors 88)) (:foreground "#5085ef" :underline t))
+    (((class color)) (:foreground "blue" :underline t))
+    (t (:underline t)))
+  "Face for process ids which are session leaders."
+  :version "29.1")
+
+(defface proced-ppid
+  '((((class color) (min-colors 88)) (:foreground "#5085bf"))
+    (((class color)) (:foreground "blue")))
+  "Face for parent process ids."
+  :version "29.1")
+
+(defface proced-pgrp
+  '((((class color) (min-colors 88)) (:foreground "#4785bf"))
+    (((class color)) (:foreground "blue")))
+  "Face for process group ids."
+  :version "29.1")
+
+(defface proced-sess
+  '((((class color) (min-colors 88)) (:foreground "#41729f"))
+    (((class color)) (:foreground "MidnightBlue")))
+  "Face for process session ids."
+  :version "29.1")
+
+(defface proced-cpu
+  '((((class color) (min-colors 88)) (:foreground "#6d5cc3" :bold t))
+    (t (:bold t)))
+  "Face for process cpu utilization."
+  :version "29.1")
+
+(defface proced-mem
+  '((((class color) (min-colors 88))
+     (: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
+  '((((class color) (min-colors 88)) (:foreground "DarkMagenta"))
+    (t (:bold t)))
+  "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 +1518,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,12 +1561,97 @@ 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)))
 
+(defun proced-format-rss (kilobytes)
+  "Format rss KILOBYTES in a human readable format."
+  (if-let ((formatted (proced-format-memory kilobytes))
+           ((and proced-enable-color-flag (not (file-remote-p default-directory))))
+           (total (car (memory-info)))
+           (proportion (/ (float kilobytes) total)))
+      (cond ((< proportion proced-low-memory-usage-threshold)
+             (propertize formatted 'font-lock-face 'proced-memory-low-usage))
+            ((< proportion proced-medium-memory-usage-threshold)
+             (propertize formatted 'font-lock-face 'proced-memory-medium-usage))
+            (t (propertize formatted 'font-lock-face 'proced-memory-high-usage)))
+    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
+                (not (file-remote-p default-directory))
+                (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
+                (not (file-remote-p default-directory))
+                (= 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."
   (if (symbolp format)
-- 
2.30.2

bug#59407: [PATCH] Add Colors to proced

[Michael Albinus]

Laurence Warne <laurencewarne@gmail.com> writes:

> Hi,

Hi Laurence,

> Also, memory-info doesn't
> appear to take into account working on remote systems like
> list-system-processes does, so I've also disabled the threshold
> highlighting for proced connected to remote machines.  Suggestions on
> this are welcome (:

Indeed. Should we make memory-info aware of remote systems, like we have
done with list-system-processes and file-system-info? At least for
remote GNU/Linux systems, reading /proc/meminfo seems to be
easy. Proper commands for *BSD and Darwin systems shall also be applicable.

Eli?

> Thanks, Laurence

Best regards, Michael.

bug#59407: [PATCH] Add Colors to proced

[Eli Zaretskii]

> From: Michael Albinus <michael.albinus@gmx.de>
> Cc: Eli Zaretskii <eliz@gnu.org>,  luangruo@yahoo.com,  59407@debbugs.gnu.org
> Date: Fri, 25 Nov 2022 12:30:33 +0100
> 
> > Also, memory-info doesn't
> > appear to take into account working on remote systems like
> > list-system-processes does, so I've also disabled the threshold
> > highlighting for proced connected to remote machines.  Suggestions on
> > this are welcome (:
> 
> Indeed. Should we make memory-info aware of remote systems, like we have
> done with list-system-processes and file-system-info? At least for
> remote GNU/Linux systems, reading /proc/meminfo seems to be
> easy. Proper commands for *BSD and Darwin systems shall also be applicable.
> 
> Eli?

I guess it would be nice, although not terribly important.

bug#59407: [PATCH] Add Colors to proced

[Michael Albinus]

Eli Zaretskii <eliz@gnu.org> writes:

Hi Eli,

>> Indeed. Should we make memory-info aware of remote systems, like we have
>> done with list-system-processes and file-system-info? At least for
>> remote GNU/Linux systems, reading /proc/meminfo seems to be
>> easy. Proper commands for *BSD and Darwin systems shall also be applicable.
>>
>> Eli?
>
> I guess it would be nice, although not terribly important.

But also not terribly hard to implement, I suppose. I'll give it a try,
and see how it goes.

Best regards, Michael.

bug#59407: [PATCH] Add Colors to proced

[Laurence Warne]

[-- Attachment #1: Type: text/plain, Size: 121 bytes --]

> But also not terribly hard to implement, I suppose. I'll give it a try,
> and see how it goes.

Great, thanks Michael!

[-- Attachment #2: Type: text/html, Size: 220 bytes --]

bug#59407: [PATCH] Add Colors to proced

[Eli Zaretskii]

> From: Laurence Warne <laurencewarne@gmail.com>
> Date: Fri, 25 Nov 2022 09:34:09 +0000
> Cc: luangruo@yahoo.com, 59407@debbugs.gnu.org, michael.albinus@gmx.de
> 
> I've attached a new patch, the changes this time are that the memory thresholds now take a proportion
> rather than a fixed value, and some of the face defaults have been improved to play nicer with 8 colour
> displays.

Thanks, see some comments below.

> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -514,6 +514,22 @@ option) and can be set to nil to disable Just-in-time Lock mode.
>  \f
>  * Changes in Emacs 29.1
>  
> +---
> +** New user option `proced-enable-color-flag` to enable coloring of proced buffers
> +This option enables prompts 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 are
> +highlighted in darker shades of orange, and the first word in the
> +args property (the executable) is highlighted in blue.
> +
> +Note this option is disabled by default and needs setting to a non-nil
> +value to take effect.

This is too long for a NEWS entry for such a minor feature.  Please make it
shorter.  Just saying that some fields of Proced display will be shown in
distinct colors, and mentioning the new defcustom to turn that on, should be
enough.

> +(defcustom proced-enable-color-flag nil
> +  "Non-nil means some process attributes will be displayed with color."

Our style is to avoid passive tense whenever possible:

  Non-nil means Proced should display some process attributes with color.

> +(defcustom proced-medium-memory-usage-threshold 0.5
> +  "The medium memory usage (in bytes) upper bound.

It is better to avoid such constructs.  Instead, say this:

  The upper bound for medium memory usage, relative to total memory.

Note that I removed "in bytes", since this is not the units in which this is
measured.

> +When `proced-enable-color-flag' is non-nil, rss values denoting a proportion
> +of memory less than this value, but greater than
> +`proced-low-memory-usage-threshold' will be displayed using the
                                      ^
Comma missing there.

> +`proced-memory-medium-usage' face.  rss values denoting a greater proportion

I think "rss" should be in all-caps, as "RSS".  Same for "VSIZE".

> +(defface proced-interruptible-sleep-status-code
> +  '((((class color)) (:foreground "DimGrey"))

Is this color visible well on both dark and light backgrounds?

> +    (t (:italic t)))
> +  "Face used for the interruptible sleep status code character \"S\"."
> +  :version "29.1")

Please mention Proced in all the doc strings of these faces, to make it
clear they are only used by Proced.

> +(defface proced-emacs-pid
> +  '((((class color) (min-colors 88)) (:foreground "purple"))
> +    (((class color)) (:foreground "magenta")))
> +  "Face for the pid of the current Emacs process."
                   ^^^
Please use "process ID", not just its abbreviation.

> +(defface proced-pid
> +  '((((class color) (min-colors 88)) (:foreground "#5085ef"))
> +    (((class color)) (:foreground "blue")))
> +  "Face for process ids."

"Face for process IDs", note the letter-case (here and elsewhere in the
patch).

> +(defface proced-cpu
> +  '((((class color) (min-colors 88)) (:foreground "#6d5cc3" :bold t))
> +    (t (:bold t)))
> +  "Face for process cpu utilization."

"CPU", in caps.

Thanks for working on this.

bug#59407: [PATCH] Add Colors to proced

[Michael Albinus]

Laurence Warne <laurencewarne@gmail.com> writes:

Hi Laurence,

>> But also not terribly hard to implement, I suppose. I'll give it a try,
>> and see how it goes.
>
> Great, thanks Michael!

I've pushed a respective change to master. On remote GNU/Linux or *BSD
systems, memory-info shall return the appropriate values now. On other
remote systems it returns nil.

Best regards, Michael.

bug#59407: [PATCH] Add Colors to proced

[Laurence Warne]

[-- Attachment #1.1: Type: text/plain, Size: 579 bytes --]

Hi Eli,

Thanks for taking another look.

> Is this color visible well on both dark and light backgrounds?

I think it looks good on both, I've attached a couple of images to
hopefully highlight this (in the STAT column), let me know what you think.
Hopefully the attached patch addresses all of the rest of your comments.

> I've pushed a respective change to master. On remote GNU/Linux or *BSD
> systems, memory-info shall return the appropriate values now. On other
> remote systems it returns nil.

Nice, the new patch should take this into consideration.

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 796 bytes --]

[-- Attachment #2: proced-colours-1.png --]
[-- Type: image/png, Size: 471177 bytes --]

[-- Attachment #3: proced-colors-light-2.png --]
[-- Type: image/png, Size: 445299 bytes --]

[-- Attachment #4: 0001-Add-colors-to-proced.patch --]
[-- Type: text/x-patch, Size: 17529 bytes --]

From 5283278e270f47a0bd5b5063452b899dc030a400 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
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
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 the 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, proced-interruptible-sleep-status-code)
(proced-uninterruptible-sleep-status-code, proced-executable)
(proced-executable, proced-memory-gb, proced-memory-mb)
(proced-memory-default, proced-pid, proced-ppid, proced-pgrp)
(proced-sess, proced-cpu, proced-mem, proced-user, proced-time-colon):
New faces.
(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.
---
 etc/NEWS       |   8 ++
 lisp/proced.el | 255 +++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 247 insertions(+), 16 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 85fdf005e3..7953996a62 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -509,6 +509,14 @@ option) and can be set to nil to disable Just-in-time Lock mode.
 \f
 * Changes in Emacs 29.1
 
+---
+** New user option `proced-enable-color-flag` to enable coloring of proced buffers
+This option prompts some format functions to furnish their respective
+process attributes with colors in a manner similar to htop.
+
+This option is disabled by default and needs setting to a non-nil
+value to take effect.
+
 +++
 ** New user option 'major-mode-remap-alist' to specify favorite major modes.
 This user option lets you remap the default modes (e.g. 'perl-mode' or
diff --git a/lisp/proced.el b/lisp/proced.el
index ac44ae1513..f91d3d2f22 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))
@@ -141,14 +141,14 @@ proced-grammar-alist
     (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t))
     (start   "Start"   proced-format-start 6 proced-time-lessp nil (start pid) (t t nil))
     (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))
+    (rss     "RSS"     proced-format-rss 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,32 @@ proced-after-send-signal-hook
   :type 'hook
   :options '(proced-revert))
 
+(defcustom proced-enable-color-flag nil
+  "Non-nil means Proced should display some process attributes with color."
+  :type 'boolean
+  :version "29.1")
+
+(defcustom proced-low-memory-usage-threshold 0.1
+  "The upper bound for low memory usage, relative to total memory.
+
+When `proced-enable-color-flag' is non-nil, RSS values denoting a proportion
+of memory lower than this value will be displayed using the
+`proced-memory-low-usage' face."
+  :type 'float
+  :version "29.1")
+
+(defcustom proced-medium-memory-usage-threshold 0.5
+  "The upper bound for medium memory usage, relative to total memory.
+
+When `proced-enable-color-flag' is non-nil, RSS values denoting a proportion
+of memory less than this value, but greater than
+`proced-low-memory-usage-threshold', will be displayed using the
+`proced-memory-medium-usage' face.  RSS values denoting a greater proportion
+than this value will be displayed using the `proced-memory-high-usage'
+face."
+  :type 'float
+  :version "29.1")
+
 ;; Internal variables
 
 (defvar proced-available t;(not (null (list-system-processes)))
@@ -403,6 +429,112 @@ 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 in Proced buffers for the running or runnable status code character \"R\"."
+  :version "29.1")
+
+(defface proced-interruptible-sleep-status-code
+  '((((class color) (min-colors 88)) (:foreground "DimGrey"))
+    (t (:italic t)))
+  "Face used in Proced buffers for the interruptible sleep status code character \"S\"."
+  :version "29.1")
+
+(defface proced-uninterruptible-sleep-status-code
+  '((((class color)) (:foreground "red"))
+    (t (:bold t)))
+  "Face used in Proced buffers for the uninterruptible sleep status code character \"D\"."
+  :version "29.1")
+
+(defface proced-executable
+  '((((class color) (min-colors 88) (background dark)) (:foreground "DeepSkyBlue"))
+    (((class color) (background dark)) (:foreground "cyan"))
+    (((class color) (background light)) (:foreground "blue"))
+    (t (:bold t)))
+  "Face used in Proced buffers for executables (first word in the args process attribute)."
+  :version "29.1")
+
+(defface proced-memory-high-usage
+  '((((class color) (min-colors 88) (background dark)) (:foreground "orange"))
+    (((class color) (min-colors 88) (background light)) (:foreground "OrangeRed"))
+    (((class color)) (:foreground "red"))
+    (t (:underline t)))
+  "Face used in Proced buffers for high memory usage."
+  :version "29.1")
+
+(defface proced-memory-medium-usage
+  '((((class color) (min-colors 88) (background dark)) (:foreground "yellow3"))
+    (((class color) (min-colors 88) (background light)) (:foreground "orange"))
+    (((class color)) (:foreground "yellow")))
+  "Face used in Proced buffers for medium memory usage."
+  :version "29.1")
+
+(defface proced-memory-low-usage
+  '((((class color) (min-colors 88) (background dark)) (:foreground "#8bcd50"))
+    (((class color)) (:foreground "green")))
+  "Face used in Proced buffers for low memory usage."
+  :version "29.1")
+
+(defface proced-emacs-pid
+  '((((class color) (min-colors 88)) (:foreground "purple"))
+    (((class color)) (:foreground "magenta")))
+  "Face used in Proced buffers for the process ID of the current Emacs process."
+  :version "29.1")
+
+(defface proced-pid
+  '((((class color) (min-colors 88)) (:foreground "#5085ef"))
+    (((class color)) (:foreground "blue")))
+  "Face used in Proced buffers for process IDs."
+  :version "29.1")
+
+(defface proced-session-leader-pid
+  '((((class color) (min-colors 88)) (:foreground "#5085ef" :underline t))
+    (((class color)) (:foreground "blue" :underline t))
+    (t (:underline t)))
+  "Face used in Proced buffers for process IDs which are session leaders."
+  :version "29.1")
+
+(defface proced-ppid
+  '((((class color) (min-colors 88)) (:foreground "#5085bf"))
+    (((class color)) (:foreground "blue")))
+  "Face used in Proced buffers for parent process IDs."
+  :version "29.1")
+
+(defface proced-pgrp
+  '((((class color) (min-colors 88)) (:foreground "#4785bf"))
+    (((class color)) (:foreground "blue")))
+  "Face used in Proced buffers for process group IDs."
+  :version "29.1")
+
+(defface proced-sess
+  '((((class color) (min-colors 88)) (:foreground "#41729f"))
+    (((class color)) (:foreground "MidnightBlue")))
+  "Face used in Proced buffers for process session IDs."
+  :version "29.1")
+
+(defface proced-cpu
+  '((((class color) (min-colors 88)) (:foreground "#6d5cc3" :bold t))
+    (t (:bold t)))
+  "Face used in Proced buffers for process CPU utilization."
+  :version "29.1")
+
+(defface proced-mem
+  '((((class color) (min-colors 88))
+     (:foreground "#6d5cc3")))
+  "Face used in Proced buffers for process memory utilization."
+  :version "29.1")
+
+(defface proced-user
+  '((t (:bold t)))
+  "Face used in Proced buffers for the user owning the process."
+  :version "29.1")
+
+(defface proced-time-colon
+  '((((class color) (min-colors 88)) (:foreground "DarkMagenta"))
+    (t (:bold t)))
+  "Face used in Proced buffers 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.")
@@ -1392,26 +1524,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)))))
 
@@ -1429,12 +1567,97 @@ 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)))
 
+(defun proced-format-rss (kilobytes)
+  "Format RSS KILOBYTES in a human readable format."
+  (let ((formatted (proced-format-memory kilobytes)))
+    (if-let* ((proced-enable-color-flag)
+              (total (car (memory-info)))
+              (proportion (/ (float kilobytes) total)))
+        (cond ((< proportion proced-low-memory-usage-threshold)
+               (propertize formatted 'font-lock-face 'proced-memory-low-usage))
+              ((< proportion proced-medium-memory-usage-threshold)
+               (propertize formatted 'font-lock-face 'proced-memory-medium-usage))
+              (t (propertize formatted 'font-lock-face 'proced-memory-high-usage)))
+      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
+                (not (file-remote-p default-directory))
+                (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
+                (not (file-remote-p default-directory))
+                (= 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."
   (if (symbolp format)
-- 
2.30.2

bug#59407: [PATCH] Add Colors to proced

[Eli Zaretskii]

> From: Laurence Warne <laurencewarne@gmail.com>
> Date: Tue, 29 Nov 2022 14:02:52 +0000
> Cc: Eli Zaretskii <eliz@gnu.org>, luangruo@yahoo.com, 59407@debbugs.gnu.org
> 
> Nice, the new patch should take this into consideration.

Thanks, installed on the release branch, and closing the bug.

bug#59407: [PATCH] Add Colors to proced

[Laurence Warne]

[-- Attachment #1: Type: text/plain, Size: 33 bytes --]

Great, thanks for your patience.

[-- Attachment #2: Type: text/html, Size: 69 bytes --]