emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/xpm 4ecdff4 28/37: * xpm: Fix cl-lib usage and compilat


From: Stefan Monnier
Subject: [elpa] externals/xpm 4ecdff4 28/37: * xpm: Fix cl-lib usage and compilation failures.
Date: Sat, 28 Nov 2020 14:15:35 -0500 (EST)

branch: externals/xpm
commit 4ecdff40528f16218b00a0d7082e2902539331a3
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * xpm: Fix cl-lib usage and compilation failures.
---
 xpm-compose.el | 66 +++++++++++++++++++++++++++++-----------------------------
 xpm-ops.el     | 20 ++++++++++--------
 xpm-palette.el |  9 ++++----
 xpm-ui.el      | 36 +++++++++++++++++---------------
 4 files changed, 68 insertions(+), 63 deletions(-)

diff --git a/xpm-compose.el b/xpm-compose.el
index 61107b9..435e41b 100644
--- a/xpm-compose.el
+++ b/xpm-compose.el
@@ -29,14 +29,14 @@
   (xpm--w/gg (w h origin flags) xpm--gg
     (save-excursion
       (goto-char origin)
-      (loop with skip = (if (memq 'intangible-sides flags)
-                            1
-                          4)
-            repeat h
-            collect (let ((p (point)))
-                      (forward-char w)
-                      (prog1 (buffer-substring-no-properties p (point))
-                        (forward-char skip)))))))
+      (cl-loop with skip = (if (memq 'intangible-sides flags)
+                               1
+                             4)
+               repeat h
+               collect (let ((p (point)))
+                         (forward-char w)
+                         (prog1 (buffer-substring-no-properties p (point))
+                           (forward-char skip)))))))
 
 (defun xpm--clone (src)
   (insert-buffer-substring src)
@@ -72,28 +72,28 @@ This copies all pixels from TWO that are not PX."
       (let ((lines (with-current-buffer two
                      (xpm--lines))))
         ;; fluency from congruency...
-        (assert (= cpp (length px)))
-        (assert (= h (length lines)))
-        (assert (or (zerop h)           ; GIGO :-/
+        (cl-assert (= cpp (length px)))
+        (cl-assert (= h (length lines)))
+        (cl-assert (or (zerop h)           ; GIGO :-/
                     (= (* cpp w) (length (car lines)))))
         ;; do it
         (goto-char origin)
-        (loop with skip = (if (memq 'intangible-sides flags)
-                              1
-                            4)
-              for line in lines
-              do (loop
-                  ;; this is slow and stupid
-                  ;; todo: use ‘compare-strings’
-                  for x below w
-                  do (let* ((i (* x cpp))
-                            (el (substring line i (+ i cpp))))
-                       (if (string= px el)
-                           (forward-char cpp)
-                         (insert el)
-                         (delete-char cpp))))
-              do (when (< (point) (point-max))
-                   (forward-char skip)))
+        (cl-loop with skip = (if (memq 'intangible-sides flags)
+                                 1
+                               4)
+                 for line in lines
+                 do (cl-loop
+                     ;; this is slow and stupid
+                     ;; todo: use ‘compare-strings’
+                     for x below w
+                     do (let* ((i (* x cpp))
+                               (el (substring line i (+ i cpp))))
+                          (if (string= px el)
+                              (forward-char cpp)
+                            (insert el)
+                            (delete-char cpp))))
+                 do (when (< (point) (point-max))
+                      (forward-char skip)))
         (current-buffer)))))
 
 (defun xpm-fill (px)
@@ -101,9 +101,9 @@ This copies all pixels from TWO that are not PX."
   (interactive "sPX: ")
   (xpm--w/gg (w h) (xpm--gate)
     (save-excursion
-      (loop with x = (cons 0 (1- w))
-            for y below h
-            do (xpm-put-points px x y)))))
+      (cl-loop with x = (cons 0 (1- w))
+               for y below h
+               do (xpm-put-points px x y)))))
 
 (provide 'xpm-compose)
 
@@ -125,11 +125,11 @@ This copies all pixels from TWO that are not PX."
         (xpm-fill ?-)
         (cl-flet
             ((vec () (let ((v (make-vector 42 nil)))
-                       (loop for i below 42
-                             do (aset v i (random 10)))
+                       (cl-loop for i below 42
+                                do (aset v i (random 10)))
                        v)))
           (xpm-put-points ?\s (vec) (vec))))
-      (assert (and (bufferp one)
+      (cl-assert (and (bufferp one)
                    (bufferp two))))
     ;; mogrify
     (let* ((debug-ignored-errors nil)
diff --git a/xpm-ops.el b/xpm-ops.el
index 67989ca..a2bc96a 100644
--- a/xpm-ops.el
+++ b/xpm-ops.el
@@ -20,6 +20,8 @@
 ;;; Code:
 
 (require 'queue)
+(require 'cl-lib)
+(require 'xpm)
 
 (defun xpm-flood-fill (px x y)
   (xpm--w/gg (cpp origin y-mult) (xpm--gate)
@@ -38,21 +40,21 @@
                           (beg x)
                           (end x))
                      (when (oldp)
-                       (loop while (oldp)
-                             do (backward-char cpp)
-                             do (decf beg)
-                             finally do (incf beg))
+                       (cl-loop while (oldp)
+                                do (backward-char cpp)
+                                do (cl-decf beg)
+                                finally do (cl-incf beg))
                        (goto-char p)
-                       (loop while (oldp)
-                             do (forward-char cpp)
-                             do (incf end)
-                             finally do (decf end))
+                       (cl-loop while (oldp)
+                                do (forward-char cpp)
+                                do (cl-incf end)
+                                finally do (cl-decf end))
                        (cons beg end)))))
         (setq bye (let ((p (pos x y)))
                     (buffer-substring-no-properties
                      p (+ p cpp))))
         (queue-enqueue q (cons x y))
-        (loop until (queue-empty q)
+        (cl-loop until (queue-empty q)
               do (let* ((coord (queue-dequeue q))
                         (ext (extent coord)))
                    (when ext
diff --git a/xpm-palette.el b/xpm-palette.el
index ff93890..b8663d5 100644
--- a/xpm-palette.el
+++ b/xpm-palette.el
@@ -22,11 +22,12 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'xpm)
 
 (defun xpm--palette-alist (cpp pinfo)
   (cl-flet ((sub (beg len) (buffer-substring-no-properties
                             beg (+ beg len))))
-    (loop
+    (cl-loop
      with bye = (point)
      with (beg . ht) = pinfo
      initially do (goto-char beg)
@@ -37,9 +38,9 @@
      collect
      (cons px (if (consp (setq color (gethash px ht)))
                   color
-                (goto-char (incf p cpp))
+                (goto-char (cl-incf p cpp))
                 (puthash                ; optimism
-                 px (loop
+                 px (cl-loop
                      with ls = (split-string
                                 (sub p (skip-chars-forward "^\"")))
                      while ls
@@ -69,7 +70,7 @@
                    (delete-and-extract-region
                     p (progn (forward-sexp 1)
                              (point))))))
-      (insert (format " %d" (incf count n))))))
+      (insert (format " %d" (cl-incf count n))))))
 
 (defun xpm-drop-px (px &optional noerror)
   "Drop PX from palette.
diff --git a/xpm-ui.el b/xpm-ui.el
index 2f4e440..fb6a9dc 100644
--- a/xpm-ui.el
+++ b/xpm-ui.el
@@ -26,15 +26,17 @@
 
 ;; 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."
@@ -44,14 +46,14 @@
           (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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]