master 4eb0303: Compute chart-face-list dynamically

[Lars Ingebrigtsen]

branch: master
commit 4eb030319725cfe7fe17049e91fdbed2e222a3c9
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Compute chart-face-list dynamically
    
    * lisp/emacs-lisp/chart.el (chart-face-list): Allow a function as
    the value (bug#47133) so that we can compute the faces dynamically
    on different displays.
    (chart--face-list): New function.
    (chart-draw-data): Use it.
---
 lisp/emacs-lisp/chart.el | 64 +++++++++++++++++++++++++++---------------------
 1 file changed, 36 insertions(+), 28 deletions(-)

diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 40c17b9..5afc6d3 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -89,33 +89,39 @@ Useful if new Emacs is used on B&W display.")
 
 (declare-function x-display-color-cells "xfns.c" (&optional terminal))
 
-(defvar chart-face-list
-  (if (display-color-p)
-      (let ((cl chart-face-color-list)
-            (pl chart-face-pixmap-list)
-            (faces ())
-            nf)
-        (while cl
-          (setq nf (make-face
-                    (intern (concat "chart-" (car cl) "-" (car pl)))))
-          (set-face-background nf (if (condition-case nil
-                                          (> (x-display-color-cells) 4)
-                                        (error t))
-                                      (car cl)
-                                    "white"))
-          (set-face-foreground nf "black")
-          (if (and chart-face-use-pixmaps pl)
-              (condition-case nil
-                  (set-face-background-pixmap nf (car pl))
-                (error (message "Cannot set background pixmap %s" (car pl)))))
-          (push nf faces)
-          (setq cl (cdr cl)
-                pl (cdr pl)))
-        faces))
+(defvar chart-face-list #'chart--face-list
   "Faces used to colorize charts.
+This should either be a list of faces, or a function that returns
+a list of faces.
+
 List is limited currently, which is ok since you really can't display
 too much in text characters anyways.")
 
+(defun chart--face-list ()
+  (and
+   (display-color-p)
+   (let ((cl chart-face-color-list)
+         (pl chart-face-pixmap-list)
+         (faces ())
+         nf)
+     (while cl
+       (setq nf (make-face
+                 (intern (concat "chart-" (car cl) "-" (car pl)))))
+       (set-face-background nf (if (condition-case nil
+                                       (> (x-display-color-cells) 4)
+                                     (error t))
+                                   (car cl)
+                                 "white"))
+       (set-face-foreground nf "black")
+       (if (and chart-face-use-pixmaps pl)
+           (condition-case nil
+               (set-face-background-pixmap nf (car pl))
+             (error (message "Cannot set background pixmap %s" (car pl)))))
+       (push nf faces)
+       (setq cl (cdr cl)
+             pl (cdr pl)))
+     faces)))
+
 (define-derived-mode chart-mode special-mode "Chart"
   "Define a mode in Emacs for displaying a chart."
   (buffer-disable-undo)
@@ -374,7 +380,10 @@ of the drawing."
   (let* ((data (oref c sequences))
         (dir (oref c direction))
         (odir (if (eq dir 'vertical) 'horizontal 'vertical))
-       )
+         (faces
+          (if (functionp chart-face-list)
+              (funcall chart-face-list)
+            chart-face-list)))
     (while data
       (if (stringp (car (oref (car data) data)))
          ;; skip string lists...
@@ -390,10 +399,9 @@ of the drawing."
                  (zp (if (eq dir 'vertical)
                          (chart-translate-ypos c 0)
                        (chart-translate-xpos c 0)))
-                 (fc (if chart-face-list
-                         (nth (% i (length chart-face-list)) chart-face-list)
-                       'default))
-                 )
+                 (fc (if faces
+                         (nth (% i (length faces)) faces)
+                       'default)))
              (if (< dp zp)
                  (progn
                    (chart-draw-line dir (car rng) dp zp)