ttn pushed a commit to branch ttn-xpm
in repository elpa.
commit ab2b926054884c63520412721243b175a00b3b24
Author: Thien-Thi Nguyen <t...@gnu.org>
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 <t...@gnu.org>
+;; 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
