[elpa] 05/07: add xpm-ui.el

[Thien-Thi Nguyen]

ttn pushed a commit to branch ttn-xpm
in repository elpa.

commit ab2b926054884c63520412721243b175a00b3b24
Author: Thien-Thi Nguyen <address@hidden>
Date:   Tue May 13 12:42:22 2014 +0200

    add xpm-ui.el
---
 packages/xpm/xpm-ui.el |   87 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 87 insertions(+), 0 deletions(-)

diff --git a/packages/xpm/xpm-ui.el b/packages/xpm/xpm-ui.el
new file mode 100644
index 0000000..996c084
--- /dev/null
+++ b/packages/xpm/xpm-ui.el
@@ -0,0 +1,87 @@
+;;; xpm-ui.el --- xpm-* plus pretty redisplay   -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014  Free Software Foundation, Inc.
+
+;; Author: Thien-Thi Nguyen <address@hidden>
+;; Version: -1
+
+;; 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’)
+
+(defun xpm-set-pen-func (parent normal none)
+  (lexical-let ((parent parent))
+    (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
+      (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