X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/9da6e5f58037bd2417f8d83189f0ab461aab3a71..23a624ca1d40fa9cefd7229ac6152b79278a6517:/packages/xpm/xpm.el diff --git a/packages/xpm/xpm.el b/packages/xpm/xpm.el index 9ab50bb46..8e189c648 100644 --- a/packages/xpm/xpm.el +++ b/packages/xpm/xpm.el @@ -4,7 +4,9 @@ ;; Author: Thien-Thi Nguyen ;; Maintainer: Thien-Thi Nguyen -;; Version: -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 @@ -49,8 +51,8 @@ ;; 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 @@ -58,16 +60,13 @@ ;; ;; Some things are autoloaded. Which ones? Use the source, Luke! ;; (Alternatively, just ask on help-gnu-emacs (at gnu dot org).) -;; -;; -;; See Also -;; - HACKING: -;; - Tip Jar: ;;; Code: (require 'cl-lib) +(autoload 'image-toggle-display "image-mode" t) ; hmm is this TRT? + (defvar xpm-raster-inhibit-continuity-optimization nil "Non-nil disables a heuristic in `xpm-raster' filling. Normally, if you pass a well-formed (closed, no edge crossings) @@ -93,8 +92,8 @@ shape to `xpm-raster', then you can ignore this variable.") 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 @@ -115,18 +114,19 @@ the buffer intangible. Optional arg SIMPLE inhibits that." (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) @@ -143,12 +143,14 @@ the buffer intangible. Optional arg SIMPLE inhibits that." ((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 "\n") (push 'intangible-sides (xpm--flags gg))) (set-buffer-modified-p mod))) @@ -174,6 +176,8 @@ the buffer intangible. Optional arg SIMPLE inhibits that." ;;;###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 @@ -184,14 +188,15 @@ a character or string of length CPP, and COLOR is a string. 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))) @@ -203,17 +208,19 @@ This example presumes CPP is 1." (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))) @@ -224,11 +231,11 @@ This example presumes CPP is 1." 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. @@ -251,7 +258,9 @@ Silently ignore out-of-range coordinates." (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) @@ -269,15 +278,19 @@ Silently ignore out-of-range coordinates." (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)))))) @@ -304,32 +317,35 @@ see variable `xpm-raster-inhibit-continuity-optimization'." ;; 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) @@ -337,7 +353,7 @@ see variable `xpm-raster-inhibit-continuity-optimization'." 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)) @@ -362,7 +378,7 @@ see variable `xpm-raster-inhibit-continuity-optimization'." (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 @@ -376,7 +392,7 @@ see variable `xpm-raster-inhibit-continuity-optimization'." 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 @@ -400,7 +416,7 @@ see variable `xpm-raster-inhibit-continuity-optimization'." (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)