diff options
Diffstat (limited to 'emacs.d/nxhtml/util/gpl.el')
| -rw-r--r-- | emacs.d/nxhtml/util/gpl.el | 213 |
1 files changed, 0 insertions, 213 deletions
diff --git a/emacs.d/nxhtml/util/gpl.el b/emacs.d/nxhtml/util/gpl.el deleted file mode 100644 index a109555..0000000 --- a/emacs.d/nxhtml/util/gpl.el +++ /dev/null @@ -1,213 +0,0 @@ -;;; gpl.el --- Highlight and edit gpl color palettes - -(defconst gpl:version "0.01") -;; Copyright (C) 2008 Niels Giesen - -;; Author: Niels Giesen -;; Keywords: extensions, tools - -;; 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: - -;; GPL provides font-locking and has functions to edit the values -;; of colors (hue, saturation value, red, green and blue vals) -;; in-place in a simple, intuitive, and lightweight fashion. See the -;; documentation of `gpl-mode'. - -;; The methods and keybindings used are roughly the same as in the new -;; css-color mode. I should maybe have abstracted both color notation -;; models better, but did not feel like it. With under 200 lines of -;; code, it did not seem worth the effort. - -;; The css-color.el used is the one by Niels Giesen, at -;; `http://niels.kicks-ass.org/public/elisp/css-color.el'. - -;; Installation: - -;; Put this file in your load-path. Put a declaration such as - -;; (autoload 'gpl-mode "gpl") -;; (add-to-list 'auto-mode-alist -;; '("\\.gpl\\'" . gpl-mode)) - -;; In your initialization file (e.g. ~/.emacs) to make sure `gpl-mode' -;; is started anytime you open a *.gpl file, and gpl-mode is only -;; loaded when needed. - -;;; Code: -(require 'css-color) - -(defvar gpl-keywords - '(("^[[:space:]]*\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)[[:space:]]+\\([a-fA-F[:digit:]]\\{1,3\\}\\)" - (0 - (let ((color (concat "#" (apply 'css-color-rgb-to-hex - (mapcar 'string-to-number - (list - (match-string-no-properties 1) - (match-string-no-properties 2) - (match-string-no-properties 3))))))) - - (put-text-property (match-beginning 0) - (match-end 0) - 'keymap gpl-map) - (put-text-property (match-beginning 0) - (match-end 0) - 'face (list :background - color - :foreground - (css-color-foreground-color - color)))))))) - -;;;###autoload -(define-derived-mode gpl-mode fundamental-mode "GPL" - "Mode for font-locking and editing color palettes of the GPL format. - -Such palettes are used and produced by free software applications -such as the GIMP, Inkscape, Scribus, Agave and on-line tools such -as http://colourlovers.com. - -You can also use -URL `http://niels.kicks-ass.org/public/elisp/css-palette.el' to import -such palette into a css-file as hexadecimal color palette." - (setq font-lock-defaults - '((gpl-keywords) - t))) - -(defvar gpl-map - (let ((m (make-sparse-keymap))) - (define-key m "=" 'gpl-up) - (define-key m "-" 'gpl-down) - (define-key m "h" 'gpl-hue-up) - (define-key m "H" 'gpl-hue-down) - (define-key m "v" 'gpl-value-up) - (define-key m "V" 'gpl-value-down) - (define-key m "s" 'gpl-saturation-up) - (define-key m "S" 'gpl-saturation-down) - m) - "Mode map for `gpl-mode'") - -(defun gpl-get-color-at-point () - (or (get-text-property (point) 'color) - (apply 'css-color-rgb-to-hsv - (gpl-get-rgb-list-at-point)))) - -(defun gpl-get-rgb-list-at-point () - (mapcar 'string-to-number - (split-string - (buffer-substring-no-properties - (point-at-bol) - (+ 11 (point-at-bol))) "[[:space:]]+" t))) - -(defun gpl-replcolor-at-p (fun increment) - (let ((pos (point))) - (beginning-of-line) - (insert - (funcall fun - (gpl-get-color-at-point) - increment)) - (delete-region (point) (+ (point) 11)) - (goto-char pos))) - -(defun gpl-hsv-to-gimp-color (h s v) - (propertize - (apply 'format "%3d %3d %3d" - (css-color-hsv-to-rgb h s v)) - 'keymap gpl-map - 'color (list h s v))) - -(defun gpl-what-channel () - (/ (- (point) (point-at-bol)) 4)) - -(defun gpl-adjust-channel-at-p (incr) - (interactive "p") - (let ((pos (point)) - (channel (gpl-what-channel))) - (beginning-of-line) - (let ((rgb - (gpl-get-rgb-list-at-point))) - (setf (nth channel rgb) - (css-color-within-bounds - (+ incr (nth channel rgb)) - 0 255)) - (delete-region (point) (+ 11 (point))) - (insert - (propertize - (apply 'format "%3d %3d %3d" rgb) - 'keymap gpl-map - 'color nil))) - (goto-char pos))) - -(defun gpl-inchue (color incr) - (destructuring-bind (h s v) color - (gpl-hsv-to-gimp-color - (+ incr h) s v))) - -(defun gpl-incsat (color incr) - (destructuring-bind (h s v) color - (gpl-hsv-to-gimp-color - h (css-color-within-bounds (+ incr s) 0 100) v))) - -(defun gpl-incval (color incr) - (destructuring-bind (h s v) color - (gpl-hsv-to-gimp-color - h s (css-color-within-bounds (+ incr v) 0 100)))) - -(defun gpl-adj-hue-at-p (increment) - (interactive "p") - (gpl-replcolor-at-p 'gpl-inchue increment)) - -(defun gpl-adj-saturation-at-p (increment) - (interactive "p") - (gpl-replcolor-at-p 'gpl-incsat increment)) - -(defun gpl-adj-value-at-p (increment) - (interactive "p") - (gpl-replcolor-at-p 'gpl-incval increment)) - -;; channels (r, g, b) -(defun gpl-up (val) - (interactive "p") - (gpl-adjust-channel-at-p val)) - -(defun gpl-down (val) - (interactive "p") - (gpl-adjust-channel-at-p (- val))) -;; hue -(defun gpl-hue-up (val) - (interactive "p") - (gpl-adj-hue-at-p val)) - -(defun gpl-hue-down (val) - (interactive "p") - (gpl-adj-hue-at-p (- val))) -;; saturation -(defun gpl-saturation-up (val) - (interactive "p") - (gpl-adj-saturation-at-p val)) - -(defun gpl-saturation-down (val) - (interactive "p") - (gpl-adj-saturation-at-p (- val))) -;; value -(defun gpl-value-up (val) - (interactive "p") - (gpl-adj-value-at-p val)) - -(defun gpl-value-down (val) - (interactive "p") - (gpl-adj-value-at-p (- val))) - -(provide 'gpl) -;;; gpl.el ends here |