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 (defun xpm-set-pen-func (parent normal none)
30 (lexical-let ((parent parent))
33 (let* ((was (current-buffer))
34 (px (get-text-property 0 'px color))
35 (again (assoc px normal)))
36 (switch-to-buffer parent)
37 (message "%S | %S %s | %S" was px color again)))))
39 (defun xpm-list-palette-display ()
40 "Display palette in another buffer."
42 (xpm--w/gg (cpp pinfo) (xpm--gate)
43 (let ((inhibit-read-only t)
44 (name (format "*%s Palette*" (buffer-name)))
46 ;; normalize and extract "None" if necessary
47 (loop for (px . alist) in (xpm--palette-alist cpp pinfo)
48 ;; todo: handle case where there is no ‘c’
49 do (let ((color (cdr (assq 'c alist))))
50 (if (member color '("none" "None"))
54 finally do (setq normal (nreverse normal)))
55 (list-colors-display (mapcar 'cdr normal) name
56 (xpm-set-pen-func (current-buffer)
59 (switch-to-buffer name)
60 (delete-other-windows)
61 (goto-char (point-min))
62 ;; ugly; better to not ‘insert’ and just add text properties.
63 ;; also, focus is on px so we can hang it on ‘color-name’ directly
65 (insert (propertize (format "%S\tnone" none)
66 'color-name (propertize "none" 'px none))
69 (let* ((px (car (pop normal)))
70 (all (text-properties-at (point)))
71 (color (plist-get all 'color-name))
72 (button (plist-get all 'button))
73 (action (plist-get all 'action)))
76 'color-name (propertize color 'px px)
79 'category 'default-button
82 (goto-char (point-min)))))
84 ;;; xpm-ui.el ends here