]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/xpm/xpm-ui.el
Merge commit 'd12ddaa05f582ecc00e74bc42fd46652153ec7a6' from company
[gnu-emacs-elpa] / packages / xpm / xpm-ui.el
index 2f4e44035bdbafa62892a52e71e32081533960cd..fb6a9dcbb0323ca4ef6c5abd3f7a128128bd588b 100644 (file)
 
 ;; todo: var ‘xpm-current-px’ (or maybe ‘xpm-quill’)
 
-(defun xpm-set-pen-func (parent normal none)
-  (lexical-let ((parent parent))
-    (lambda (color)
-      ;; see "hang" below
-      (let* ((was (current-buffer))
-             (px (get-text-property 0 'px color))
-             (again (assoc px normal)))
-        (switch-to-buffer parent)
-        (message "%S | %S %s | %S" was px color again)))))
+(eval-when-compile (require 'cl-lib))
+(require 'xpm)
+
+(defun xpm-set-pen-func (parent normal _none)
+  (lambda (color)
+    ;; see "hang" below
+    (let* ((was (current-buffer))
+           (px (get-text-property 0 'px color))
+           (again (assoc px normal)))
+      (switch-to-buffer parent)
+      (message "%S | %S %s | %S" was px color again))))
 
 (defun xpm-list-palette-display ()
   "Display palette in another buffer."
           (name (format "*%s Palette*" (buffer-name)))
           normal none)
       ;; normalize and extract "None" if necessary
-      (loop for (px . alist) in (xpm--palette-alist cpp pinfo)
-            ;; todo: handle case where there is no ‘c’
-            do (let ((color (cdr (assq 'c alist))))
-                 (if (member color '("none" "None"))
-                     (setq none px)
-                   (push (cons px color)
-                         normal)))
-            finally do (setq normal (nreverse normal)))
+      (cl-loop for (px . alist) in (xpm--palette-alist cpp pinfo)
+               ;; todo: handle case where there is no ‘c’
+               do (let ((color (cdr (assq 'c alist))))
+                    (if (member color '("none" "None"))
+                        (setq none px)
+                      (push (cons px color)
+                            normal)))
+               finally do (setq normal (nreverse normal)))
       (list-colors-display (mapcar 'cdr normal) name
                            (xpm-set-pen-func (current-buffer)
                                              normal