;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
-;; Version: 1.0.1
+;; Version: 1.0.3
;; Keywords: multimedia, xpm
+;; URL: http://www.gnuvola.org/software/xpm/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; are "congruent" if their width, height and cpp are identical.
;;
;; This package was originally conceived for non-interactive use,
-;; so its design is spartan at the core. However, we plan on
-;; adding a XPM mode in a future release; see HACKING link below.
+;; so its design is spartan at the core. However, we plan to add
+;; a XPM mode in a future release; monitor the homepage for updates.
;;
;; For now, the features (w/ correspondingly-named files) are:
;; - xpm -- edit XPM images
;;
;; Some things are autoloaded. Which ones? Use the source, Luke!
;; (Alternatively, just ask on help-gnu-emacs (at gnu dot org).)
-;;
-;;
-;; See Also
-;; - HACKING: <http://git.sv.gnu.org/cgit/emacs/elpa.git/tree/packages/xpm/HACKING>
-;; - Tip Jar: <http://www.gnuvola.org/software/xpm/>
;;; Code:
(require 'cl-lib)
-(eval-when-compile (require 'cl))
(autoload 'image-toggle-display "image-mode" t) ; hmm is this TRT?
When called as a command, display in the echo area a
summary of image dimensions, cpp and palette.
Set buffer-local variable `xpm--gg' and return its value.
-Normally, preparation includes making certain parts of
-the buffer intangible. Optional arg SIMPLE inhibits that."
+Normally, preparation includes making certain parts of the
+buffer intangible. Optional arg SIMPLE non-nil inhibits that."
(interactive)
(unless (or
;; easy
(goto-char (point-min))
(search-forward "{")
(skip-chars-forward "^\"")
- (destructuring-bind (w h nc cpp &rest rest)
+ (cl-destructuring-bind (w h nc cpp &rest rest)
(read (format "(%s)" (read (current-buffer))))
(ignore rest) ; for now
(forward-line 1)
(setq pinfo (point-marker))
- (loop repeat nc
- do (let ((p (1+ (point))))
- (puthash (buffer-substring-no-properties
- p (+ p cpp))
- ;; Don't bother w/ CVALUE for now.
- t ht)
- (forward-line 1)))
+ (cl-loop
+ repeat nc
+ do (let ((p (1+ (point))))
+ (puthash (buffer-substring-no-properties
+ p (+ p cpp))
+ ;; Don't bother w/ CVALUE for now.
+ t ht)
+ (forward-line 1)))
(setq pinfo (cons pinfo ht))
(skip-chars-forward "^\"")
(forward-char 1)
((suppress (span &rest more)
(let ((p (point)))
(add-text-properties
- (- p span) p (list* 'intangible t
- more)))))
+ (- p span) p (cl-list*
+ 'intangible t
+ more)))))
(suppress 1)
- (loop repeat h
- do (progn (forward-char (+ 4 (* w cpp)))
- (suppress 4)))
+ (cl-loop
+ repeat h
+ do (progn (forward-char (+ 4 (* w cpp)))
+ (suppress 4)))
(suppress 2 'display "\a\ e\15\n\ 6\13\ 6")
(push 'intangible-sides (xpm--flags gg)))
(set-buffer-modified-p mod)))
;;;###autoload
(defun xpm-generate-buffer (name width height cpp palette)
"Return a new buffer in XPM image format.
+In this buffer, undo is disabled (see `buffer-enable-undo').
+
NAME is the buffer and XPM name. For best interoperation
with other programs, NAME should be a valid C identifier.
WIDTH, HEIGHT and CPP are integers that specify the image
If COLOR includes a space, it is included directly,
otherwise it is automatically prefixed with \"c \".
-For example, to produce fragment:
+For example, to produce palette fragment:
\"X c blue\",
\"Y s border c green\",
you can specify PALETTE as:
- ((?X . \"blue\") (?Y . \"s border c green\"))
+ ((?X . \"blue\")
+ (?Y . \"s border c green\"))
This example presumes CPP is 1."
(let ((buf (generate-new-buffer name)))
(yep "/* XPM */")
(yep "static char * %s[] = {" name)
(yep "\"%d %d %d %d\"," width height (length palette) cpp)
- (loop for (px . color) in palette
- do (yep "\"%s %s\","
- (if (characterp px)
- (string px)
- px)
- (if (string-match " " color)
- color
- (concat "c " color))))
- (loop with s = (format "%S,\n" (make-string (* cpp width) 32))
- repeat height
- do (insert s))
+ (cl-loop
+ for (px . color) in palette
+ do (yep "\"%s %s\","
+ (if (characterp px)
+ (string px)
+ px)
+ (if (string-match " " color)
+ color
+ (concat "c " color))))
+ (cl-loop
+ with s = (format "%S,\n" (make-string (* cpp width) 32))
+ repeat height
+ do (insert s))
(delete-char -2)
(yep "};")
(xpm-grok t)))
If both X and Y are vectors of length N, then place N points
using the pairwise vector elements. If one of X or Y is a vector
-of length N, then pair its elements with the other integer component
-and place N points.
+of length N and the other component is an integer, then pair the
+vector elements with the integer component and place N points.
If one of X or Y is a pair (LOW . HIGH), take it to be equivalent
-t specfiying a vector [LOW ... HIGH]. For example, (3 . 8) is
+to specfiying a vector [LOW ... HIGH]. For example, (3 . 8) is
equivalent to [3 4 5 6 7 8]. If one component is a pair, the
other must be an integer -- the case where both X and Y are pairs
is not supported.
(pos col row)
(if (= 1 cpp)
(insert-char px len)
- (loop repeat len do (insert px)))
+ (cl-loop
+ repeat len
+ do (insert px)))
(delete-char (* cpp len)))
(zow (col row)
(unless (out col row)
(when (stringp px)
(setq px (aref px 0)))
(jam beg y len)))))
- (`(integer . cons) (loop for two from (car y) to (cdr y)
- do (zow x two)))
- (`(vector . integer) (loop for one across x
- do (zow one y)))
- (`(integer . vector) (loop for two across y
- do (zow x two)))
- (`(vector . vector) (loop for one across x
- for two across y
- do (zow one two)))
+ (`(integer . cons) (cl-loop
+ for two from (car y) to (cdr y)
+ do (zow x two)))
+ (`(vector . integer) (cl-loop
+ for one across x
+ do (zow one y)))
+ (`(integer . vector) (cl-loop
+ for two across y
+ do (zow x two)))
+ (`(vector . vector) (cl-loop
+ for one across x
+ for two across y
+ do (zow one two)))
(`(integer . integer) (zow x y))
(_ (error "Bad coordinates: X %S, Y %S"
x y))))))
;; state, on a line-by-line basis.
int nin
ext)
- (loop for (x . y) in form
- do (setq x-min (min x-min x)
- x-max (max x-max x)
- y-min (min y-min y)
- y-max (max y-max y))
- unless (or (> 0 y)
- (<= h y))
- do (push x (aref v y)))
+ (cl-loop
+ for (x . y) in form
+ do (setq x-min (min x-min x)
+ x-max (max x-max x)
+ y-min (min y-min y)
+ y-max (max y-max y))
+ unless (or (> 0 y)
+ (<= h y))
+ do (push x (aref v y)))
(cl-flet
((span (lo hi)
(- hi lo -1))
(norm (n)
(- n x-min))
(rset (bv start len value)
- (loop for i from start repeat len
- do (aset bv i value)))
+ (cl-loop
+ for i from start repeat len
+ do (aset bv i value)))
(scan (bv start len yes no)
- (loop for i from start repeat len
- when (aref bv i)
- return yes
- finally return no)))
+ (cl-loop
+ for i from start repeat len
+ when (aref bv i)
+ return yes
+ finally return no)))
(let ((len (span x-min x-max)))
(setq int (make-bool-vector len nil)
nin (make-bool-vector len nil)
ext (make-bool-vector len t)))
- (loop
+ (cl-loop
with (ls
in-map-ok
in-map)
when (setq ls (and (< -1 y)
(> h y)
(sort (aref v y) '>)))
- do (loop
+ do (cl-loop
with acc = (list (car ls))
for maybe in (cdr ls)
do (let* ((was (car acc))
(cl-evenp was)))
(setq in-map (make-bool-vector now nil)))))
finally do
- (loop
+ (cl-loop
with (x rangep beg nx end len nb in)
for gap from 0
while acc
x))
t))
(if rangep
- (destructuring-bind (b . e) x
+ (cl-destructuring-bind (b . e) x
(rset ext (norm b) (span b e) nil))
(aset ext (norm x) nil))
(when acc
(rset nin nb len t)
(xpm-put-points fill (cons beg end) y))))
finally do (when fill
- (rotatef int nin)
+ (cl-rotatef int nin)
(fillarray nin nil)))))))))
(defun xpm-as-xpm (&rest props)