Subject: bug#77775: 30.1; Proced performance

From: Rahguzar <[email-masked]>
Date: Wed, 04 Jun 2025 10:22:02 +0500

Hi Roland,
Roland Winkler <[email-masked]> writes:

> On Sun, Jun 01 2025, Rahguzar wrote:
>> Gentle ping! Is there any interest in this?
>
> I am sorry, the delay is my fault, I have been swamped with other stuff.
> I'll try to catch up as quick as I can.

Please take your time. Meanwhile, I am attaching the patch I am
proposing. Please review when it is convenient.

Rahguzar

>From 248c05855fa0e2bd92c5535c25f4890e4e9a574c Mon Sep 17 00:00:00 2001
From: Rahguzar <[email-masked]>
Date: Sun, 13 Apr 2025 11:27:33 +0500
Subject: [PATCH 2/2] * lisp/proced.el: Optimize retrieval of process
 attributes

(proced-format-current-process): new variable
(proced-format-pid, proced-format): use the variable
---
 lisp/proced.el | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/lisp/proced.el b/lisp/proced.el
index e68383df10e..59ff10ac3d8 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -428,6 +428,9 @@ proced-sort-internal
   "Sort scheme for listing (internal format).
 It is a list of lists (KEY PREDICATE REVERSE).")
 
+(defvar proced-format-current-process nil
+  "Variable holding the process being formatted by function `proced-format'.")
+
 (defvar proced-marker-char ?*		; the answer is 42
   "In Proced, the current mark character.")
 
@@ -1682,13 +1685,13 @@ proced-format-state
 
 (defun proced-format-pid (pid)
   "Format PID."
-  (let ((proc-info (process-attributes pid))
-        (pid-s (number-to-string pid)))
+  (let ((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)))
+          ((and proced-enable-color-flag
+                (equal pid (alist-get 'sess proced-format-current-process)))
            (propertize pid-s 'font-lock-face 'proced-session-leader-pid))
           (proced-enable-color-flag
            (propertize pid-s 'font-lock-face 'proced-pid))
@@ -1747,8 +1750,7 @@ proced-format
   ;; attributes, we take the first attribute that is non-nil for `emacs-pid'.
   ;; If none of the alternatives is non-nil, the attribute is ignored
   ;; in the listing.
-  (let ((standard-attributes
-         (car (proced-process-attributes (list-system-processes))))
+  (let ((standard-attributes (car process-alist))
         new-format fmi)
     (if (and proced-tree-flag
              (assq 'ppid standard-attributes))
@@ -1814,7 +1816,8 @@ proced-format
                  (end-of-line)
                  (setq value (cdr (assq key (cdr process))))
                  (insert (if value
-                             (apply #'propertize (funcall fun value) fprops)
+                             (let ((proced-format-current-process process))
+                               (apply #'propertize (funcall fun value) fprops))
                            (format (concat "%" (number-to-string (nth 3 grammar)) "s")
                                    unknown))
                          whitespace)
@@ -1828,7 +1831,9 @@ proced-format
                (dolist (process process-alist)
                  (end-of-line)
                  (setq value (cdr (assq key (cdr process))))
-                 (insert (if value (apply #'propertize (funcall fun value) fprops)
+                 (insert (if value
+                             (let ((proced-format-current-process process))
+                               (apply #'propertize (funcall fun value) fprops))
                            unknown))
                  (forward-line))
                (push (apply #'propertize (nth 1 grammar) hprops) header-list))
@@ -1839,7 +1844,8 @@ proced-format
                  (dolist (process process-alist)
                    (setq value (cdr (assq key (cdr process))))
                    (if value
-                       (setq value (apply #'propertize (funcall fun value) fprops)
+                       (setq value (let ((proced-format-current-process process))
+                                     (apply #'propertize (funcall fun value) fprops))
                              width (max width (length value))
                              field-list (cons value field-list))
                      (push unknown field-list)
-- 
2.49.0