1 ;;; xpm-ui.el --- xpm-* plus pretty redisplay -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22 ;; ??? hmm, since this will probably be the future home of xpm-mode,
23 ;; why not rename the file as xpm-mode.el?
27 ;; todo: var ‘xpm-current-px’ (or maybe ‘xpm-quill’)
29 (eval-when-compile (require 'cl-lib))
32 (defun xpm-set-pen-func (parent normal _none)
35 (let* ((was (current-buffer))
36 (px (get-text-property 0 'px color))
37 (again (assoc px normal)))
38 (switch-to-buffer parent)
39 (message "%S | %S %s | %S" was px color again))))
41 (defun xpm-list-palette-display ()
42 "Display palette in another buffer."
44 (xpm--w/gg (cpp pinfo) (xpm--gate)
45 (let ((inhibit-read-only t)
46 (name (format "*%s Palette*" (buffer-name)))
48 ;; normalize and extract "None" if necessary
49 (cl-loop for (px . alist) in (xpm--palette-alist cpp pinfo)
50 ;; todo: handle case where there is no ‘c’
51 do (let ((color (cdr (assq 'c alist))))
52 (if (member color '("none" "None"))
56 finally do (setq normal (nreverse normal)))
57 (list-colors-display (mapcar 'cdr normal) name
58 (xpm-set-pen-func (current-buffer)
61 (switch-to-buffer name)
62 (delete-other-windows)
63 (goto-char (point-min))
64 ;; ugly; better to not ‘insert’ and just add text properties.
65 ;; also, focus is on px so we can hang it on ‘color-name’ directly
67 (insert (propertize (format "%S\tnone" none)
68 'color-name (propertize "none" 'px none))
71 (let* ((px (car (pop normal)))
72 (all (text-properties-at (point)))
73 (color (plist-get all 'color-name))
74 (button (plist-get all 'button))
75 (action (plist-get all 'action)))
78 'color-name (propertize color 'px px)
81 'category 'default-button
84 (goto-char (point-min)))))
86 ;;; xpm-ui.el ends here