[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master e560bc8: * externals-list: Convert xpm to :external
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master e560bc8: * externals-list: Convert xpm to :external |
|
Date: |
Sat, 28 Nov 2020 14:16:23 -0500 (EST) |
branch: master
commit e560bc85865006197f7e1c1268890759a08af445
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* externals-list: Convert xpm to :external
---
externals-list | 1 +
packages/xpm/.elpaignore | 6 -
packages/xpm/HACKING | 59 ------
packages/xpm/NEWS | 31 ----
packages/xpm/THANKS | 6 -
packages/xpm/flower.el | 105 -----------
packages/xpm/xpm-compose.el | 146 ---------------
packages/xpm/xpm-m2z.el | 101 ----------
packages/xpm/xpm-ops.el | 68 -------
packages/xpm/xpm-palette.el | 131 -------------
packages/xpm/xpm-ui.el | 88 ---------
packages/xpm/xpm.el | 437 --------------------------------------------
12 files changed, 1 insertion(+), 1178 deletions(-)
diff --git a/externals-list b/externals-list
index 67f5c50..535a3cd 100644
--- a/externals-list
+++ b/externals-list
@@ -182,6 +182,7 @@
("wisitoken-grammar-mode" :external nil)
("which-key" :external "https://github.com/justbur/emacs-which-key";)
("xelb" :external "https://github.com/ch11ng/xelb.git";)
+ ("xpm" :external nil)
("xr" :external "https://github.com/mattiase/xr";)
("xref" :core "lisp/progmodes/xref.el")
("yasnippet" :external
"https://github.com/capitaomorte/yasnippet.git";)
diff --git a/packages/xpm/.elpaignore b/packages/xpm/.elpaignore
deleted file mode 100644
index 2336dba..0000000
--- a/packages/xpm/.elpaignore
+++ /dev/null
@@ -1,6 +0,0 @@
-HACKING
-flower.el
-xpm-compose.el
-xpm-ops.el
-xpm-palette.el
-xpm-ui.el
diff --git a/packages/xpm/HACKING b/packages/xpm/HACKING
deleted file mode 100644
index ae9a88a..0000000
--- a/packages/xpm/HACKING
+++ /dev/null
@@ -1,59 +0,0 @@
-HACKING xpm.el (et al) -*- org -*-
-
-This file is both a guide for newcomers and a todo list for oldstayers.
-
-* ideas / wishlist
-*** lacunae (sigh)
-(defun xpm-as-rectangle ()
- (xpm--w/gg (w h cpp origin y-mult) (xpm--gate)
- (extract-rectangle
- origin
- (+ origin (* y-mult (1- h)) (* w cpp)))))
-
-(defun xpm-from-rectangle (rect)
- (xpm--w/gg (w h cpp origin y-mult) (xpm--gate)
- (assert (= h (length rect)))
- (assert (= (* w cpp) (length (car rect))))
- (goto-char origin)
- (delete-rectangle origin (+ origin (* y-mult (1- h)) (* w cpp)))
- (insert-rectangle rect)))
-
-(defun xpm-replace-from (buffer)
- (xpm-from-rectangle
- (with-current-buffer buffer
- (xpm-as-rectangle))))
-*** add xpm-mode for interactive use -- [[file:xpm-ui.el][xpm-ui.el]]
-***** hide/show header lines
-***** palette
-******* hide/show
-******* display each PX in associated color (loses for ‘s’-only)
-******* display as table (conserve vertical space)
-******* add state "current px", commands to set it
-***** hide/show sides
-*** composition facilities -- [[file:xpm-compose.el][xpm-compose.el]]
-***** multilevel congruence
-******* dimensions only
-******* palette not None
-******* palette subset
-******* full palette
-***** destructive (2-op) vs non-destructive (3-op)
-***** customizable pixel-compose fn
-*** misc functionality
-***** validate palette-data correspondance
-***** import from rectangle
-******* as-is (dangerous)
-******* w/ char-to-px quantization
-*** perf
-***** ??? use ‘binary’ coding system
-***** make ‘xpm-raster’ do [vh]-line expansion
-* copyright policy
-*** update every year, unconditionally
-*** (if (< 2 (- END BEGIN)) RANGE INDIVIDUAL)
-* etc
-#+odd
-
-
-Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-Copying and distribution of this file, with or without modification,
-are permitted provided the copyright notice and this notice are preserved.
diff --git a/packages/xpm/NEWS b/packages/xpm/NEWS
deleted file mode 100644
index 5a3d24a..0000000
--- a/packages/xpm/NEWS
+++ /dev/null
@@ -1,31 +0,0 @@
-NEWS for xpm.el (et al)
-See the end for copying conditions.
-
-
-- 1.0.4 | 2017-02-17
- - fixed syntax error in ‘defstruct’ usage (how did it work before?!)
- - new THANKS file
-
-- 1.0.3 | 2014-06-13
- - improved docstrings
-
-- 1.0.2 | 2014-05-30
- - new homepage: http://www.gnuvola.org/software/xpm/
-
-- 1.0.1 | 2014-05-21
- - byte-compilation bugfix
-
-- 1.0.0 | 2014-05-18
- - initial release
-
-
- Local Variables:
- mode: outline
- outline-regexp: "\\([ ][ ]\\)*- "
- End:
-
-_____________________________________________________________________
-Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-Copying and distribution of this file, with or without modification,
-are permitted provided the copyright notice and this notice are preserved.
diff --git a/packages/xpm/THANKS b/packages/xpm/THANKS
deleted file mode 100644
index a52388d..0000000
--- a/packages/xpm/THANKS
+++ /dev/null
@@ -1,6 +0,0 @@
-These people have helped to improve xpm.el (et al).
-
- Stefan Monnier
-
-If you are not here, but should be, that's a bug -- please accept
-our apologies for the oversight, and report it, so we can DTRT!
diff --git a/packages/xpm/flower.el b/packages/xpm/flower.el
deleted file mode 100644
index 35c0005..0000000
--- a/packages/xpm/flower.el
+++ /dev/null
@@ -1,105 +0,0 @@
-;;; flower.el --- can `xpm-raster' DTRT? -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
-
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file helps visualize `xpm-raster' failure modes. Maybe one
-;; day it will be rendered useless by improvements to `xpm-raster'.
-;;
-;; NB: There is no `provide' form.
-;; NB: Loading munges the global keymap -- YHBW!
-
-;;; Code:
-
-(require 'xpm)
-(require 'xpm-m2z)
-(require 'cl-lib)
-
-(defvar flower-size 99
- "Number of pixels in the flower image (a square).
-For best results, this should be at least 99 and odd.")
-
-(defun flower (&optional again)
- "Stress `xpm-raster' in various ways."
- (interactive "P")
- (let ((buf (get-buffer "flower")))
- (when buf (kill-buffer buf)))
- (switch-to-buffer
- (xpm-generate-buffer "flower" flower-size flower-size 2
- '((" " . "green")
- (".." . "yellow")
- ("OO" . "red")
- ("--" . "black"))))
- (setq truncate-lines t)
- (let* ((τ (* 4 2 (atan 1)))
- (half (/ flower-size 2.0))
- (mag-fns (vector (lambda (θ) (ignore θ) 1)
- (lambda (θ) (sin θ))
- (lambda (θ) (cos θ))
- (lambda (θ) (sin (* 0.5 τ θ)))
- (lambda (θ) (cos (* 0.5 τ θ)))
- (lambda (θ) (sin (* 0.25 τ θ)))
- (lambda (θ) (cos (* 0.25 τ θ)))
- (lambda (θ) (sin (* τ θ)))
- (lambda (θ) (cos (* τ θ)))))
- (n-mag-fns (length mag-fns)))
- (cl-flet
- ((random-mag-fn () (aref mag-fns (random n-mag-fns)))
- (form (fn &rest args) (apply fn half half (random 42) args)))
- (let* ((x-mag-fn (random-mag-fn))
- (y-mag-fn (random-mag-fn))
- (form (if again
- (get 'flower 'form)
- (delete-dups
- (if (zerop (random 5))
- (let ((one (form 'xpm-m2z-circle))
- (two (form 'xpm-m2z-ellipse (random 42))))
- (append one two))
- (cl-loop
- with bias = (* 0.42 half)
- with mm = (+ bias (random (truncate bias)))
- for θ below τ by 0.003
- collect
- (cl-flet
- ((at (f mfn)
- (truncate (+ half (* mm (funcall mfn θ)
- (funcall f θ))))))
- (cons (at 'cos x-mag-fn)
- (at 'sin y-mag-fn)))))))))
- (put 'flower 'form form)
- (xpm-raster form "OO" ".."))))
- (image-mode)
- ;; strangely, image-mode screws up the markers, so we need to do
- ;; this again if we want to do subsequent xpm-* access:
- ;;+ (xpm-grok t)
- t)
-
-;;;---------------------------------------------------------------------------
-;;; load-time actions
-
-(global-set-key [f9] 'flower)
-(global-set-key
- [(meta f9)]
- (lambda () (interactive)
- (message "xpm-raster-inhibit-continuity-optimization now %s"
- (setq xpm-raster-inhibit-continuity-optimization
- (not xpm-raster-inhibit-continuity-optimization)))))
-
-;;; flower.el ends here
diff --git a/packages/xpm/xpm-compose.el b/packages/xpm/xpm-compose.el
deleted file mode 100644
index cdb099f..0000000
--- a/packages/xpm/xpm-compose.el
+++ /dev/null
@@ -1,146 +0,0 @@
-;;; xpm-compose.el --- two or more buffers -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; TODO
-
-;;; Code:
-
-(require 'xpm)
-(require 'cl-lib)
-
-(defun xpm--lines ()
- ;; (maybe) todo: use rectangle funcs
- (xpm--w/gg (w h origin flags) xpm--gg
- (save-excursion
- (goto-char origin)
- (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)
- (setq xpm--gg (xpm--copy-gg (buffer-local-value 'xpm--gg src))))
-
-(defun xpm-buffer-from (image &optional name)
- "Return a new XPM buffer initialized from IMAGE.
-IMAGE should have type `xpm'. NAME is the new buffer name,
-which defaults to the name specified in IMAGE."
- (let* ((plist (cdr image))
- source populate)
- (cond ((setq source (plist-get plist :file))
- (setq populate 'insert-file-contents))
- ((setq source (plist-get plist :data))
- (setq populate 'insert))
- (t (error "Invalid image: %S" image)))
- (with-current-buffer (generate-new-buffer
- (or name "*TMP* for xpm-buffer-from"))
- (funcall populate source)
- (unless name
- (goto-char (point-min))
- (re-search-forward "\\(\\S-+\\)\\[\\]")
- (rename-buffer (match-string 1)))
- (current-buffer))))
-
-(defun xpm-compose (name one two px)
- "Return new buffer NAME, by composing buffers ONE and TWO.
-This copies all pixels from TWO that are not PX."
- (when (characterp px)
- (setq px (string px)))
- (with-current-buffer (generate-new-buffer name)
- (xpm--w/gg (w h cpp origin flags) (xpm--clone one)
- (let ((lines (with-current-buffer two
- (xpm--lines))))
- ;; fluency from congruency...
- (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)
- (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)
- "Fill with PX."
- (interactive "sPX: ")
- (xpm--w/gg (w h) (xpm--gate)
- (save-excursion
- (cl-loop
- with x = (cons 0 (1- w))
- for y below h
- do (xpm-put-points px x y)))))
-
-(provide 'xpm-compose)
-
-
-(defun ttn-test-xpm-compose ()
- (interactive)
- (cl-flet ((zonk (name) (let ((buf (get-buffer name)))
- (when buf (kill-buffer buf)))))
- (mapc #'zonk '("one" "two" "zow"))
- ;; create
- (let* ((palette '((?\s . "black") ; bg
- (?# . "green") ; fg
- (?X . "red")
- (?- . "None")))
- (one (xpm-generate-buffer "one" 10 10 1 palette))
- (two (xpm-generate-buffer "two" 10 10 1 palette)))
- (with-current-buffer one (xpm-fill ?#))
- (with-current-buffer two
- (xpm-fill ?-)
- (cl-flet
- ((vec () (let ((v (make-vector 42 nil)))
- (cl-loop
- for i below 42
- do (aset v i (random 10)))
- v)))
- (xpm-put-points ?\s (vec) (vec))))
- (cl-assert (and (bufferp one)
- (bufferp two))))
- ;; mogrify
- (let* ((debug-ignored-errors nil)
- (one (get-buffer "one"))
- (two (get-buffer "two"))
- (zow (xpm-compose "zow" one two ?-)))
- (when (bufferp zow)
- (switch-to-buffer zow)))))
-
-;;; xpm-compose.el ends here
diff --git a/packages/xpm/xpm-m2z.el b/packages/xpm/xpm-m2z.el
deleted file mode 100644
index 90bde60..0000000
--- a/packages/xpm/xpm-m2z.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; xpm-m2z.el --- (% span 2) => 0 -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
-
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Although artist.el is wonderful, it doesn't (yet) do subpixel-centered
-;; circles (or ellipses). Those shapes are always rendered with an odd
-;; "span", i.e., (% (- HI LO -1) 2) => 1, since the origin is *on* an
-;; integral coordinate (i.e., intersection of row and column).
-;;
-;; This file provides funcs `xpm-m2z-ellipse' and `xpm-m2z-circle' to
-;; locally rectify the current situation ("m2z" means "modulo 2 => 0"),
-;; with the hope that eventually a generalization can be worked back
-;; into artist.el, perhaps as a subpixel-center minor mode of some sort.
-
-;;; Code:
-
-(require 'artist)
-(require 'cl-lib)
-
-;;;###autoload
-(defun xpm-m2z-ellipse (cx cy rx ry)
- "Return an ellipse with center (CX,CY) and radii RX and RY.
-Both CX and CY must be non-integer, preferably
-precisely half-way between integers, e.g., 13/2 => 6.5.
-The ellipse is represented as a list of unique XPM coords,
-with the \"span\", i.e., (- HI LO -1), of the extreme X and Y
-components equal to twice the rounded (to integer) value of
-RX and RY, respectively. For example:
-
- (xpm-m2z-ellipse 1.5 3.5 5.8 4.2)
- => list of length 20
-
- min max span
- X -3 6 10
- Y 0 7 8
-
-The span is always an even number. As a special case, if the
-absolute value of RX or RY is less than 1, the value is nil."
- (cl-assert (and (not (integerp cx))
- (not (integerp cy)))
- nil "Integer component in center coordinate: (%S,%S)"
- cx cy)
- (unless (or (> 1 (abs rx))
- (> 1 (abs ry)))
- (cl-flet*
- ((offset (coord idx)
- (- (aref coord idx) 0.5))
- (normal (coord)
- ;; flip axes: artist (ROW,COL) to xpm (X,Y)
- (cons
- (offset coord 1) ; 1: COL -> car: X
- (offset coord 0))) ; 0: ROW -> cdr: Y
- (placed (origin scale n)
- (truncate (+ origin (* scale n))))
- (orient (coords quadrant)
- (cl-loop
- with (sx . sy) = quadrant
- for (x . y) in coords
- collect (cons (placed cx sx x)
- (placed cy sy y)))))
- (delete-dups
- (cl-loop
- with coords = (mapcar
- #'normal
- (artist-ellipse-generate-quadrant
- ;; Specify row first; artist.el is like that.
- ;; (That's why ‘normal’ does what it does...)
- ry rx))
- for quadrant ; these are in order: I-IV
- in '(( 1 . 1) ; todo: "manually" remove single
- (-1 . 1) ; (border point) overlaps;
- (-1 . -1) ; avoid ‘delete-dups’
- ( 1 . -1))
- append (orient coords quadrant))))))
-
-;;;###autoload
-(defun xpm-m2z-circle (cx cy radius)
- "Like `xpm-m2z-ellipse' with a shared radius RADIUS."
- (xpm-m2z-ellipse cx cy radius radius))
-
-(provide 'xpm-m2z)
-
-;;; xpm-m2z.el ends here
diff --git a/packages/xpm/xpm-ops.el b/packages/xpm/xpm-ops.el
deleted file mode 100644
index 0f34ee2..0000000
--- a/packages/xpm/xpm-ops.el
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; xpm-ops.el --- drawing operations -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'queue)
-(require 'cl-lib)
-(require 'xpm)
-
-(defun xpm-flood-fill (px x y)
- (xpm--w/gg (cpp origin y-mult) (xpm--gate)
- (let ((q (queue-create))
- bye)
- (cl-labels
- ((pos (x y) (+ origin (* cpp x) (* y-mult y)))
- (cur () (let ((p (point)))
- (buffer-substring-no-properties
- p (+ p cpp))))
- (oldp () (string= bye (cur)))
- (extent (coord)
- (let* ((x (car coord))
- (y (cdr coord))
- (p (goto-char (pos x y)))
- (beg x)
- (end x))
- (when (oldp)
- (cl-loop
- while (oldp)
- do (backward-char cpp)
- do (cl-decf beg)
- finally do (cl-incf beg))
- (goto-char p)
- (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))
- (cl-loop
- until (queue-empty q)
- do (let* ((coord (queue-dequeue q))
- (ext (extent coord)))
- (when ext
- (xpm-put-points px ext y)
- ;; todo: expansion and queuing of y-1 and y+1
- )))))))
-
-;;; xpm-ops.el ends here
diff --git a/packages/xpm/xpm-palette.el b/packages/xpm/xpm-palette.el
deleted file mode 100644
index c9dd217..0000000
--- a/packages/xpm/xpm-palette.el
+++ /dev/null
@@ -1,131 +0,0 @@
-;;; xpm-palette.el --- manage PX/COLOR set -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; TODO
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'xpm)
-
-(defun xpm--palette-alist (cpp pinfo)
- (cl-flet ((sub (beg len) (buffer-substring-no-properties
- beg (+ beg len))))
- (cl-loop
- with bye = (point)
- with (beg . ht) = pinfo
- initially do (goto-char beg)
- with (p px color)
- repeat (hash-table-count ht)
- do (setq p (1+ (point))
- px (sub p cpp))
- collect
- (cons px (if (consp (setq color (gethash px ht)))
- color
- (goto-char (cl-incf p cpp))
- (puthash ; optimism
- px (cl-loop
- with ls = (split-string
- (sub p (skip-chars-forward "^\"")))
- while ls
- collect (cons (intern (pop ls))
- (pop ls)))
- ht)))
- do (forward-line 1)
- finally do (goto-char bye))))
-
-(defun xpm--validate-px (cpp px)
- (when (/= cpp (length px))
- (error "Invalid px %S (expecting length %d)" px cpp))
- t)
-
-(defun xpm--adjust-npal (n palette)
- ;; Change count of colors by adding N to the current value.
- ;; But first, move point to POS, which should be
- ;; the colors list bol (and leave it there when done).
- ;; See `xpm-drop-px' and `xpm-add-px'.
- (goto-char (car palette))
- (save-excursion
- (search-backward "\n\"")
- (forward-char 2) ; LF, double-quote
- (forward-sexp 2) ; WIDTH and HEIGHT
- (let* ((p (point))
- (count (string-to-number
- (delete-and-extract-region
- p (progn (forward-sexp 1)
- (point))))))
- (insert (format " %d" (cl-incf count n))))))
-
-(defun xpm-drop-px (px &optional noerror)
- "Drop PX from palette.
-Signal error if PX is not found.
-Optional arg NOERROR inhibits this.
-Return the deleted entry if PX was found."
- (xpm--w/gg (cpp pinfo origin) (xpm--gate)
- (let* ((ht (cdr pinfo))
- (ent (when (xpm--validate-px cpp px)
- (gethash px ht))))
- (unless (or ent noerror)
- (error "No such px: %S" px))
- (when ent
- (remhash px ht)
- (xpm--adjust-npal -1 pinfo)
- (re-search-forward (concat "^\"" px "\\s-.*$") origin)
- (delete-region (match-beginning 0) (1+ (match-end 0)))
- ent))))
-
-(defun xpm-add-px (px color &optional append)
- "Add an entry associating PX with COLOR to the palette.
-If COLOR is a string, it is associated using the ‘c’ type.
-Otherwise, it should be an alist with symbolic types and
-string values, for instance:
-
- ((s . \"border\")
- (c . \"blue\"))
-
-Aside from ‘c’olor and ‘s’ymbolic, there is also ‘g’rayscale,
-‘m’onochrome and ‘g4’ (four-level gray scale).
-
-The new entry is normally added to the front.
-Optional arg APPEND non-nil means add it to the rear."
- (xpm--w/gg (cpp pinfo origin) (xpm--gate)
- (let ((alist (pcase color
- ((pred stringp) (list (cons 'c color)))
- ((pred consp) color)
- (_ (error "Invalid COLOR: %S" color))))
- (ht (cdr pinfo)))
- (xpm--validate-px cpp px)
- (xpm-drop-px px t)
- (xpm--adjust-npal 1 pinfo)
- (unless (or (not append)
- (zerop (hash-table-count ht)))
- (goto-char (1- origin))
- (skip-chars-backward "^,")
- (forward-line 1))
- (insert "\"" px " " (mapconcat
- (lambda (pair)
- (format "%s %s" (car pair) (cdr pair)))
- alist
- " ")
- "\",\n")
- (puthash px alist ht))))
-
-(provide 'xpm-palette)
-
-;;; xpm-palette.el ends here
diff --git a/packages/xpm/xpm-ui.el b/packages/xpm/xpm-ui.el
deleted file mode 100644
index e79ee55..0000000
--- a/packages/xpm/xpm-ui.el
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; xpm-ui.el --- xpm-* plus pretty redisplay -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; TODO
-;;
-;; ??? hmm, since this will probably be the future home of xpm-mode,
-;; why not rename the file as xpm-mode.el?
-
-;;; Code:
-
-;; todo: var ‘xpm-current-px’ (or maybe ‘xpm-quill’)
-
-(eval-when-compile (require 'cl-lib))
-(require 'xpm)
-(require 'xpm-palette)
-
-(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."
- (interactive)
- (xpm--w/gg (cpp pinfo) (xpm--gate)
- (let ((inhibit-read-only t)
- (name (format "*%s Palette*" (buffer-name)))
- normal none)
- ;; normalize and extract "None" if necessary
- (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
- none))
- (switch-to-buffer name)
- (delete-other-windows)
- (goto-char (point-min))
- ;; ugly; better to not ‘insert’ and just add text properties.
- ;; also, focus is on px so we can hang it on ‘color-name’ directly
- (when none
- (insert (propertize (format "%S\tnone" none)
- 'color-name (propertize "none" 'px none))
- "\n"))
- (while normal
- (let* ((px (car (pop normal)))
- (all (text-properties-at (point)))
- (color (plist-get all 'color-name))
- (button (plist-get all 'button))
- (action (plist-get all 'action)))
- (insert (propertize
- (format "%S\t" px)
- 'color-name (propertize color 'px px)
- 'button button
- 'action action
- 'category 'default-button
- 'follow-link t)))
- (forward-line 1))
- (goto-char (point-min)))))
-
-;;; xpm-ui.el ends here
diff --git a/packages/xpm/xpm.el b/packages/xpm/xpm.el
deleted file mode 100644
index 929dca6..0000000
--- a/packages/xpm/xpm.el
+++ /dev/null
@@ -1,437 +0,0 @@
-;;; xpm.el --- edit XPM images -*- lexical-binding: t -*-
-
-;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
-
-;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
-;; Version: 1.0.4
-;; 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
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package makes editing XPM images easy (and maybe fun).
-;; Editing is done directly on the (textual) image format,
-;; for maximal cohesion w/ the Emacs Way.
-;;
-;; Coordinates have the form (X . Y), with X from 0 to (width-1),
-;; and Y from 0 to (height-1), inclusive, in the 4th quadrant;
-;; i.e., X grows left to right, Y top to bottom, origin top-left.
-;;
-;; (0,0) … (width-1,0)
-;; ⋮ ⋮
-;; (0,height-1) … (width-1,height-1)
-;;
-;; In xpm.el (et al), "px" stands for "pixel", a non-empty string
-;; in the external representation of the image. The px length is
-;; the image's "cpp" (characters per pixel). The "palette" is a
-;; set of associations between a px and its "color", which is an
-;; alist with symbolic TYPE and and string CVALUE. TYPE is one of:
-;;
-;; c -- color (most common)
-;; s -- symbolic
-;; g -- grayscale
-;; g4 -- four-level grayscale
-;; m -- monochrome
-;;
-;; and CVALUE is a string, e.g., "blue" or "#0000FF". Two images
-;; 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 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
-;; - xpm-m2z -- ellipse/circle w/ fractional center
-;;
-;; Some things are autoloaded. Which ones? Use the source, Luke!
-;; (Alternatively, just ask on help-gnu-emacs (at gnu dot org).)
-
-;;; 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)
-shape to `xpm-raster', then you can ignore this variable.")
-
-(cl-defstruct (xpm--gg ; gathered gleanings
- (:type vector) ; no ‘:named’ so no predicate
- (:conc-name xpm--)
- (:constructor xpm--make-gg)
- (:copier xpm--copy-gg))
- (w nil :read-only t) (h nil :read-only t) (cpp nil :read-only t)
- pinfo ; (MARKER . HASH-TABLE)
- (origin nil :read-only t)
- (y-mult nil :read-only t)
- flags)
-
-(defvar xpm--gg nil
- "Various bits for xpm.el (et al) internal use.")
-
-;;;###autoload
-(defun xpm-grok (&optional simple)
- "Analyze buffer and prepare internal data structures.
-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 non-nil inhibits that."
- (interactive)
- (unless (or
- ;; easy
- (and (boundp 'image-type)
- (eq 'xpm image-type))
- ;; hard
- (save-excursion
- (goto-char (point-min))
- (string= "/* XPM */"
- (buffer-substring-no-properties
- (point) (line-end-position)))))
- (error "Buffer not an XPM image"))
- (when (eq 'image-mode major-mode)
- (image-toggle-display))
- (let ((ht (make-hash-table :test 'equal))
- pinfo gg)
- (save-excursion
- (goto-char (point-min))
- (search-forward "{")
- (skip-chars-forward "^\"")
- (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))
- (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)
- (set (make-local-variable 'xpm--gg)
- (setq gg (xpm--make-gg
- :w w :h h :cpp cpp
- :pinfo pinfo
- :origin (point-marker)
- :y-mult (+ 4 (* cpp w)))))
- (unless simple
- (let ((mod (buffer-modified-p))
- (inhibit-read-only t))
- (cl-flet
- ((suppress (span &rest more)
- (let ((p (point)))
- (add-text-properties
- (- p span) p (cl-list*
- 'intangible t
- more)))))
- (suppress 1)
- (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)))
- (when (called-interactively-p 'interactive)
- (message "%dx%d, %d cpp, %d colors in palette"
- w h cpp (hash-table-count ht)))))
- gg))
-
-(defun xpm--gate ()
- (or xpm--gg
- (xpm-grok)
- (error "Sorry, xpm confused")))
-
-(cl-defmacro xpm--w/gg (names from &body body)
- (declare (indent 2))
- `(let* ((gg ,from)
- ,@(mapcar (lambda (name)
- `(,name (,(intern (format "xpm--%s" name))
- gg)))
- `,names))
- ,@body))
-
-;;;###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
-width, height and characters/pixel, respectively.
-
-PALETTE is an alist ((PX . COLOR) ...), where PX is either
-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 palette fragment:
-
- \"X c blue\",
- \"Y s border c green\",
-
-you can specify PALETTE as:
-
- ((?X . \"blue\")
- (?Y . \"s border c green\"))
-
-This example presumes CPP is 1."
- (let ((buf (generate-new-buffer name)))
- (with-current-buffer buf
- (buffer-disable-undo)
- (cl-flet
- ((yep (s &rest args)
- (insert (apply 'format s args) "\n")))
- (yep "/* XPM */")
- (yep "static char * %s[] = {" name)
- (yep "\"%d %d %d %d\"," width height (length palette) cpp)
- (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)))
- buf))
-
-(defun xpm-put-points (px x y)
- "Place PX at coordinate(s) (X,Y).
-
-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 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
-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.
-
-Silently ignore out-of-range coordinates."
- (xpm--w/gg (w h cpp origin y-mult) (xpm--gate)
- (when (and (stringp px) (= 1 cpp))
- (setq px (aref px 0)))
- (cl-flet*
- ((out (col row)
- (or (> 0 col) (<= w col)
- (> 0 row) (<= h row)))
- (pos (col row)
- (goto-char (+ origin (* cpp col) (* y-mult row))))
- (jam (col row len)
- (pos col row)
- (insert-char px len)
- (delete-char len))
- (rep (col row len)
- (pos col row)
- (if (= 1 cpp)
- (insert-char px len)
- (cl-loop
- repeat len
- do (insert px)))
- (delete-char (* cpp len)))
- (zow (col row)
- (unless (out col row)
- (rep col row 1))))
- (pcase (cons (type-of x) (type-of y))
- (`(cons . integer) (let* ((beg (max 0 (car x)))
- (end (min (1- w) (cdr x)))
- (len (- end beg -1)))
- (unless (or (> 1 len)
- (out beg y))
- (if (< 1 cpp)
- ;; general
- (rep beg y len)
- ;; fast(er) path
- (when (stringp px)
- (setq px (aref px 0)))
- (jam beg y len)))))
- (`(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))))))
-
-(defun xpm-raster (form edge &optional fill)
- "Rasterize FORM with EDGE pixel (character or string).
-FORM is a list of coordinates that comprise a closed shape.
-Optional arg FILL specifies a fill pixel, or t to fill with EDGE.
-
-If FORM is not closed or has inopportune vertical-facing
-concavities, filling might give bad results. For those cases,
-see variable `xpm-raster-inhibit-continuity-optimization'."
- (when (eq t fill)
- (setq fill edge))
- (xpm--w/gg (h) (xpm--gate)
- (let* ((v (make-vector h nil))
- (x-min (caar form)) ; (maybe) todo: xpm--bb
- (x-max x-min)
- (y-min (cdar form))
- (y-max y-min)
- (use-in-map (not xpm-raster-inhibit-continuity-optimization))
- ;; These are bool-vectors to keep track of both internal
- ;; (filled and its "next" (double-buffering)) and external
- ;; state, on a line-by-line basis.
- int nin
- ext)
- (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)
- (cl-loop
- for i from start repeat len
- do (aset bv i value)))
- (scan (bv start len yes 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)))
- (cl-loop
- with (ls
- in-map-ok
- in-map)
- for y from (1- y-min) to y-max
- when (setq ls (and (< -1 y)
- (> h y)
- (sort (aref v y) '>)))
- do (cl-loop
- with acc = (list (car ls))
- for maybe in (cdr ls)
- do (let* ((was (car acc))
- (already (consp was)))
- (cond ((/= (1- (if already
- (car was)
- was))
- maybe)
- (push maybe acc))
- (already
- (setcar was maybe))
- (t
- (setcar acc (cons maybe was)))))
- finally do
- (when fill
- (let ((was (length in-map))
- (now (length acc)))
- (unless (setq in-map-ok
- (and (= was now)
- ;; heuristic: Avoid being fooled
- ;; by simulataneous crossings.
- (cl-evenp was)))
- (setq in-map (make-bool-vector now nil)))))
- finally do
- (cl-loop
- with (x rangep beg nx end len nb in)
- for gap from 0
- while acc
- do (setq x (pop acc))
- do (xpm-put-points edge x y)
- do (when fill
- (setq rangep (consp x))
- (when (zerop gap)
- (rset ext 0 (norm (if rangep
- (car x)
- x))
- t))
- (if rangep
- (cl-destructuring-bind (b . e) x
- (rset ext (norm b) (span b e) nil))
- (aset ext (norm x) nil))
- (when acc
- (setq beg (1+ (if rangep
- (cdr x)
- x))
- nx (car acc)
- end (1- (if (consp nx)
- (car nx)
- nx))
- len (span beg end)
- nb (norm beg)
- in (cond ((and use-in-map in-map-ok)
- (aref in-map gap))
- (in (scan int nb len t nil))
- (t (scan ext nb len nil t))))
- (unless in-map-ok
- (aset in-map gap in))
- (if (not in)
- (rset ext nb len t)
- (rset nin nb len t)
- (xpm-put-points fill (cons beg end) y))))
- finally do (when fill
- (cl-rotatef int nin)
- (fillarray nin nil)))))))))
-
-(defun xpm-as-xpm (&rest props)
- "Return the XPM image (via `create-image') of the buffer.
-PROPS are additional image properties to place on
-the new XPM. See info node `(elisp) XPM Images'."
- (apply 'create-image (buffer-substring-no-properties
- (point-min) (point-max))
- 'xpm t props))
-
-(defun xpm-finish (&rest props)
- "Like `xpm-as-xpm', but also kill the buffer afterwards."
- (prog1 (apply 'xpm-as-xpm props)
- (kill-buffer nil)))
-
-(provide 'xpm)
-
-;;; xpm.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master e560bc8: * externals-list: Convert xpm to :external,
Stefan Monnier <=