[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
colorcomp.el
From: |
Thien-Thi Nguyen |
Subject: |
colorcomp.el |
Date: |
Sat, 20 May 2006 10:40:13 +0200 |
greetings earthlings,
please find below colorcomp.el, a simple exercise to use ewoc.el
(specifically, the one in cvs emacs). munge to taste, etc.
it may be used w/ ewoc.el in the wild, but you will probably see
extra (though harmless) blank lines.
thi
______________________________________________________________________
;;; colorcomp.el --- Manipulate color components interactively
;; Copyright (C) 2006 Thien-Thi Nguyen
;; 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Load it and try: M-x colorcomp RET forest green RET
;; Seems to work ok for my setup (256 colors under X).
;;; Code:
(require 'ewoc)
;; vars
(defvar colorcomp-ewoc nil)
(defvar colorcomp-data nil)
(defvar colorcomp-labels ["Red" "Green" "Blue"])
(defvar colorcomp-mode-map nil)
;; funcs
(defun colorcomp-pp (data)
(if data
(let ((comp (aref colorcomp-data data)))
(insert (aref colorcomp-labels data) "\t: #x"
(format "%02X" comp) " "
(make-string (ash comp -2) ?#) "\n"))
(let ((cstr (format "#%02X%02X%02X"
(aref colorcomp-data 0)
(aref colorcomp-data 1)
(aref colorcomp-data 2)))
(samp " (sample text) "))
(insert "Color\t: "
(propertize samp 'face `(foreground-color . ,cstr))
(propertize samp 'face `(background-color . ,cstr))
"\n"))))
;;;###autoload
(defun colorcomp (color)
"Allow fiddling with COLOR in a new buffer.
The buffer is in Color Components mode."
(interactive "sColor (name or #RGB or #RRGGBB): ")
(when (string= "" color)
(setq color "green"))
(unless (color-values color)
(error "No such color: %S" color))
(switch-to-buffer
(generate-new-buffer (format "originally: %s" color)))
(kill-all-local-variables)
(setq major-mode 'colorcomp-mode
mode-name "Color-Components")
(use-local-map colorcomp-mode-map)
(erase-buffer)
(buffer-disable-undo)
(let ((data (apply 'vector (mapcar (lambda (n) (ash n -8))
(color-values color))))
(ewoc (ewoc-create 'colorcomp-pp
"\nColor Components\n\n"
(substitute-command-keys
"\n\\{colorcomp-mode-map}"))))
(set (make-local-variable 'colorcomp-data) data)
(set (make-local-variable 'colorcomp-ewoc) ewoc)
(ewoc-enter-last ewoc 0)
(ewoc-enter-last ewoc 1)
(ewoc-enter-last ewoc 2)
(ewoc-enter-last ewoc nil)))
(defun colorcomp-mod (index limit delta)
(save-excursion
(let ((cur (aref colorcomp-data index))
(ewoc colorcomp-ewoc))
(unless (= limit cur)
(aset colorcomp-data index (+ cur delta)))
(ewoc-invalidate
ewoc
(ewoc-nth ewoc index)
(ewoc-nth ewoc -1)))))
(defun colorcomp-R-more () (interactive) (colorcomp-mod 0 255 1))
(defun colorcomp-G-more () (interactive) (colorcomp-mod 1 255 1))
(defun colorcomp-B-more () (interactive) (colorcomp-mod 2 255 1))
(defun colorcomp-R-less () (interactive) (colorcomp-mod 0 0 -1))
(defun colorcomp-G-less () (interactive) (colorcomp-mod 1 0 -1))
(defun colorcomp-B-less () (interactive) (colorcomp-mod 2 0 -1))
(defun colorcomp-copy-as-kill-and-exit ()
"Copy the color components into the kill ring and kill the buffer.
The string is formatted #RRGGBB (hash followed by six hex digits)."
(interactive)
(goto-char (point-min))
(insert "#"
(format "%02X" (aref colorcomp-data 0))
(format "%02X" (aref colorcomp-data 1))
(format "%02X" (aref colorcomp-data 2)))
(copy-region-as-kill (point-min) (point))
(kill-buffer nil))
;;; load-time actions
(unless colorcomp-mode-map
(setq colorcomp-mode-map
(let ((m (make-sparse-keymap)))
(suppress-keymap m)
(define-key m "i" 'colorcomp-R-less)
(define-key m "o" 'colorcomp-R-more)
(define-key m "k" 'colorcomp-G-less)
(define-key m "l" 'colorcomp-G-more)
(define-key m "," 'colorcomp-B-less)
(define-key m "." 'colorcomp-B-more)
(define-key m " " 'colorcomp-copy-as-kill-and-exit)
m)))
(provide 'colorcomp)
;;; colorcomp.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- colorcomp.el,
Thien-Thi Nguyen <=