[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 01/01: * xpm: Fix cl-lib usage and compilation failures.
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] 01/01: * xpm: Fix cl-lib usage and compilation failures. |
|
Date: |
Mon, 07 Jul 2014 18:38:33 +0000 |
monnier pushed a commit to branch master
in repository elpa.
commit d31cf3156c20512f7fcf72b383827e96cfc9718e
Author: Stefan Monnier <address@hidden>
Date: Mon Jul 7 14:38:27 2014 -0400
* xpm: Fix cl-lib usage and compilation failures.
---
packages/xpm/xpm-compose.el | 66 +++++++++++++++++++++---------------------
packages/xpm/xpm-ops.el | 20 +++++++------
packages/xpm/xpm-palette.el | 9 +++--
packages/xpm/xpm-ui.el | 36 ++++++++++++-----------
4 files changed, 68 insertions(+), 63 deletions(-)
diff --git a/packages/xpm/xpm-compose.el b/packages/xpm/xpm-compose.el
index 61107b9..435e41b 100644
--- a/packages/xpm/xpm-compose.el
+++ b/packages/xpm/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/packages/xpm/xpm-ops.el b/packages/xpm/xpm-ops.el
index 67989ca..a2bc96a 100644
--- a/packages/xpm/xpm-ops.el
+++ b/packages/xpm/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/packages/xpm/xpm-palette.el b/packages/xpm/xpm-palette.el
index ff93890..b8663d5 100644
--- a/packages/xpm/xpm-palette.el
+++ b/packages/xpm/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/packages/xpm/xpm-ui.el b/packages/xpm/xpm-ui.el
index 2f4e440..fb6a9dc 100644
--- a/packages/xpm/xpm-ui.el
+++ b/packages/xpm/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