path: root/emacs.d/nxhtml/util/css-palette.el

;;; css-palette.el

(defconst css-palette:version "0.02")
;; Copyright (C) 2008 Niels Giesen

;; Author: Niels Giesen <nielsforkgiesen@gmailspooncom, but please
;; replace the kitchen utensils with a dot before hitting "Send">
;; Keywords: processes, css, multimedia, extensions, tools
;; Homepage: http://niels.kicks-ass.org/

;; 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:

;; css-palette defines commands to have "palettes" inside a block
;; comment to circumvent the absence of (color or other) variable
;; definitions in the CSS specification. It can import and export GIMP
;; color palettes. See the documentation of `css-palette-mode'
;; for details of usage.

;;; Installation:

;; Something like:

;; put it in your load-path.

;; (autoload 'css-palette-mode "css-palette" "" t)
;; (add-hook 'css-mode-hook
;; 	  (lambda ()
;; 	    (css-palette-mode t)))

;; Notes:

;; css-palette depends on css-color.el to do font-locking.

;; ccs-palette is orthogonal to css-mode, so it could probably be used
;; inside other language modes, provided they support multiline block
;; comments.

;;; Change log:

;; 2009-01-11 Lennart Borgman
;;   - Minor code clean up.

;;; Code:
(require 'css-color)
(eval-when-compile (require 'cl))		;i'm a bad bad boy...

(defconst css-palette-hex-chars "0123456789abcdefABCDEF"
  "Composing chars in hexadecimal notation, save for the hash (#) sign.")

(defvar css-palette-mode-map
  (let ((m (make-sparse-keymap)))
    (define-key m "\C-c\C-c" 'css-palette-update-all)
    (define-key m "\C-c\C-i" 'css-palette-insert-reference)
    (define-key m "\C-c\C-p" 'css-palette-import-from-GIMP)
    (define-key m "\C-c\C-f" 'css-palette-insert-files)
    m)
  "Mode map for `css-palette-mode'")

;;;###autoload
(define-minor-mode css-palette-mode
  "Minor mode for palettes in CSS.

The mode `css-palette-mode' acts on the first COLORS declaration in your
  file of the form:

COLORS:
\(
c0 \"#6f5d25\"	;tainted sand
c1 \"#000000\"	;Black
c2 \"#cca42b\"	;goldenslumber
c3 \"#6889cb\"	;far off sky
c4 \"#fff\"	;strange aeons
)

Such declarations should appear inside a block comment, in order
  to be parsed properly by the LISP reader.

Type \\[css-palette-update-all], and any occurence of

  color: #f55; /*[c3]*/

will be updated with

  color: #6899cb; /*[c3]*/

The following commands are available to insert key-value pairs
  and palette declarations:
  \\{css-palette-mode-map}

You can extend or redefine the types of palettes by defining a
  new palette specification of the form (PATTERN REGEXP
  REF-FOLLOWS-VALUE), named according to the naming scheme
  css-palette:my-type, where

PATTERN is a pattern containing two (%s) format directives which
  will be filled in with the variable and its value,

REGEXP is a regular expression to match a value - variable
  pattern,

and REF-FOLLOWS-VALUE defined whether or not the reference comes
  after the value. This allows for more flexibility.

Note that, although the w3c spec at URL
  `http://www.w3.org/TR/CSS2/syndata.html#comments' says that
  comments \" may occur anywhere between tokens, and their
  contents have no influence on the rendering\", Internet
  Explorer does not think so. Better keep all your comments after
  a \"statement\", as per the default. This means `css-palette'
  is ill-suited for use within shorthands.

See variable `css-palette:colors' for an example of a palette
  type.

The extension mechanism means that palette types can be used to
  contain arbitrary key-value mappings.

Besides the colors palette, css-palette defines the palette
  definition variables `css-palette:colors-outside' and
  `css-palette:files', for colors with the reference outside and
  for file url()'s respectively.

You can fine-control which palette types css-palette should look
  at via the variable `css-palette-types'.

"
  nil
  "-palette"
  css-palette-mode-map
  (css-color-mode +1))

;;;###autoload
(defgroup css-palette nil
  "Customization group for css-palette library.

See function `css-palette-mode' for documentation"
  :group 'css-color)

(defcustom css-palette:colors
  `("%s; /*[%s]*/ "
    ,(concat "\\("
	     css-color-color-re
;; 	      (mapconcat
;; 	       'identity
;; 	       (list css-color-hex-re
;; 		     css-color-hsl-re
;; 		     css-color-rgb-re) "\\|")
	      "\\)"
	      "[[:space:]]*;[[:space:]]*\/\\*\\[\\([^[:space:]]+\\)\\]\\*\/")
    t)
  "Color palette specification.

See function `css-palette-mode' for documentation"
  :group 'css-palette
  :type '(list
	  (string :tag "Pattern")
	  (regexp :tag "Regexp")
	  (boolean :tag "Reversed")))

(defcustom css-palette:files
  '("url(%s); /*[%s]*/ "
    "url(\\([^)]+\\))[[:space:]]*;[[:space:]]*\/\\*\\[\\([^[:space:]]+\\)\\]\\*\/"
    t)
  "File palette specification.

See function `css-palette-mode' for documentation"
  :group 'css-palette
  :type '(list
	  (string :tag "Pattern")
	  (regexp :tag "Regexp")
	  (boolean :tag "Reversed")))

(defcustom css-palette-types
  '(colors)
  "List of palette types to check for in buffer.

See function `css-palette-mode' for documentation"
  :group 'css-palette
  :type '(repeat (symbol :tag "Palette type")))
(make-variable-buffer-local 'css-palette-types)

;; (defun css-palette-mode-turn-on ()
;;   "Turn on `css-palette-mode'."
;;   (css-palette-mode 1))

;; ;;;###autoload
;; (defcustom css-palette-mode-activate-p nil
;; "Start `css-palette-mode' when `css-mode' is activated."
;;   :group 'css-palette
;;   :set (lambda (sym val)
;;          (set-default sym val)
;;          (if val
;;              (add-hook 'css-mode-hook 'css-palette-mode-turn-on)
;;            (remove-hook 'css-mode-hook 'css-palette-mode-turn-on)))
;;   :type 'boolean)

(defun css-palette-turn-on-in-buffer ()
  "Turn on `css-palette-mode' in `css-mode'."
  (when (derived-mode-p 'css-mode)
    (message "turn-on-in-b:before (css-palette-mode 1) cb=%s" (current-buffer))
    (css-palette-mode 1)
    (message "turn-on-in-b:after (css-palette-mode 1)")
    ))

;;;###autoload
(define-globalized-minor-mode css-palette-global-mode css-palette-mode
  css-palette-turn-on-in-buffer
  :group 'css-color)

(defun css-palette-get (key spec)
  (plist-get
   (css-palette-spec-to-plist
    (symbol-value
     (intern-soft
      (format "css-palette:%s" spec)))) key))

(defun css-palette-spec-to-plist (palette)
  (destructuring-bind (pattern regexp ref-follows-value) palette
    (list :regexp regexp
	  :pattern pattern
	  :ref-follows-value ref-follows-value)))

(defun css-palette-choose-type ()
  (intern-soft
   (if (null (cdr css-palette-types))
       (car css-palette-types)
     (completing-read "Type: "
		      (mapcar 'symbol-name css-palette-types)))))

(defun css-palette-get-declaration (type)
  "Return `css-palette' declaration of TYPE in current buffer.

If none is found, throw an error."
  (let ((type (symbol-name type)))
    (save-excursion
      (goto-char (point-min))
      (or (re-search-forward (format "%s:"
				     (upcase type)) nil t)
	  (error "No %s declaration found in buffer; check value of variable
	  `css-palette-types'" type))
      (let ((palette (read (current-buffer))))
	;; Check (could be better..)
	(if (not (and
		  (listp palette)
		  (= 0 (% (length palette) 2))))
	    (error "Invalid %s " type))
	palette))))

(defun css-palette-update (type)
"Update buffer references for palette of TYPE."
  (interactive (list
		(css-palette-choose-type)))
  (let ((palette (css-palette-get-declaration type))
	(regexp (css-palette-get :regexp type))
	(ref-follows-value (css-palette-get :ref-follows-value type)))
    (flet ((getval (key palette)
		      (let ((value (plist-get palette (intern-soft key))))
			(if (null value)
			    (error
			     "%S not specified in %S palette "
			     key
			     type
			     ;;  (signal 'css-palette-not-found-error nil)
			     )
			  value))))
      (save-excursion
	(goto-char (point-min))
	(while (re-search-forward
		regexp
		(point-max) t)
	  (replace-match
	   (getval (match-string-no-properties (if ref-follows-value 2 1)) palette)
	   nil nil nil (if ref-follows-value 1 2))))))
   (css-color-mode 1))

(defun css-palette-update-all ()
  "Update all references for palettes in `css-palette-types'"
  (interactive)
  (catch 'err
    (mapc (lambda (type)
	    (condition-case err
		(css-palette-update type)
	      (if (y-or-n-p (format "%s, skip? " err))
		  nil)))
	  css-palette-types)))

;; Reference Insertion
(defun css-palette-insert-reference (type)
  "Insert `css-palette' reference of TYPE at point."
  (interactive
    (list (css-palette-choose-type)))
  (let* ((palette (css-palette-get-declaration type))
	 (ref-follows-value (css-palette-get :ref-follows-value type))
	 (pattern (css-palette-get :pattern type))
	 (var
	  (completing-read (format "%s variable: "
				   (capitalize
				    (substring (symbol-name type)
					       0 -1)))
			   (loop for i on
				 palette
				 by 'cddr
				 collect
				 (css-palette-colorify
				  (symbol-name (car i))
				  (cadr i)))))
	 (val  (plist-get palette (read var))))
    (insert (apply 'format
		   pattern
		   (if ref-follows-value
		       (list val var)
		     (list var val))))
    (css-color-mode +1)))

(defun css-palette-hex-color-p (str)
  (string-match "#\\([a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)" str))

(defun css-palette-colorify (string color)
  (let ((color (if (css-palette-hex-color-p color)
		   color
		 "#000")))
  (propertize string
	      'font-lock-face
	      (list :background color
		    :foreground (css-color-foreground-color color)
		    string)
	      'fontified t)))

;; Imports
(defun css-palette-from-existing-colors ()
  (interactive)
  (let ((palette)
	(count -1))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "#[[:digit:]a-fA-F]\\{6\\}\\>" nil t)
	(if (not (member (match-string-no-properties 0) palette))
	    (setq palette (append (list
				   (match-string-no-properties 0)
				   (intern(format "c%d" (incf count))))
				  palette)))
	(save-match-data (re-search-forward ";" nil t))
	(insert (format "/*[%S]*/" (cadr (member (match-string-no-properties 0) palette))))))
    (insert (format "COLORS:\n%S" (nreverse palette)))
    (forward-sexp -1)
    (forward-char 1)
    (while
	(not (looking-at ")"))
      (forward-sexp 2)
      (newline)
      (indent-for-tab-command))))

(defun css-palette-newest-GIMP-dir ()
  "Return newest (version-wise) ~/.gimp-n.n/palettes directory on disk.

Return `nil' if none such directory is found."
  (catch 'none
    (concat
     (or
      (car
       (last
	(directory-files "~/" t "^.gimp-[[:digit:].]\\{3,\\}")))
      (throw 'none ()))
   "/palettes/")))

(defun css-palette-import-from-GIMP ()
  "Import GIMP palette file as a `css-palette' palette.

GIMP palettes can be made with the GIMP or on-line tools such as
found at URL `http://colourlovers.com'."
  (interactive)
  (let ((file (read-file-name "File: " (css-palette-newest-GIMP-dir)))
	(this-buffer (current-buffer))
	(count -1))
    (insert "\nCOLORS:\n(\n")
    (with-temp-buffer
      (insert-file-contents file)
      (goto-char (point-min))
      (while (re-search-forward
	      (concat
	       "^"
	       "[[:space:]]*\\([[:digit:]]+\\)"  ;red
	       "[[:space:]]+\\([[:digit:]]+\\)"  ;green
	       "[[:space:]]+\\([[:digit:]]+\\)"	 ;blue
	       "[[:space:]]+\\(.*\\)$") ;name (=> used as comment)
	      nil t)
	(destructuring-bind (rb re gb ge bb be nb ne &rest ignore)
	    (cddr (match-data t))
	  (let ((color
		 (apply 'format "c%d \"#%02x%02x%02x\" ;%s\n"
			(incf count)
			(append
			 (mapcar 'string-to-number
				 (list
				  (buffer-substring-no-properties rb re)
				  (buffer-substring-no-properties gb ge)
				  (buffer-substring-no-properties bb be)))
			 (list (buffer-substring-no-properties nb ne))))))
	    (with-current-buffer this-buffer
	      (insert color))))))
    (insert ")")
    (message "C-c C-c to update colors")))

(defun css-palette-insert-files (dir)
  "Insert a `css-palette' declaration for all files in DIR.

Filenames are relative.
Main use-case: an image directory."
  (interactive "DDirectory: ")
  (save-excursion
    (let ((image-count -1))
      (insert "\nFILES:\n(\n")
      (mapc
       (lambda (f)
	 (insert
	  (format "file-%d %S\n"
		  (incf image-count)
		  (file-relative-name
		   f
		   (file-name-directory (buffer-file-name))))))
       (directory-files dir t "...+"))
      (insert ")\n\n"))))

;; Exports
(defun css-palette-export-to-GIMP (type name columns)
  "Export the COLORS declaration to a GIMP (.gpl) palette.

See also `gpl-mode' at URL
`http://niels.kicks-ass.org/public/elisp/gpl.el'."
  (interactive
   (list
    (css-palette-choose-type)
    (read-string "Name: ")
    (read-number "Number of columns: " 2)))
  (let ((palette (css-palette-get-declaration type)))
    (find-file
     (concat (css-palette-newest-GIMP-dir)
	     name
	     ".gpl"))
    (insert
     (format "GIMP Palette
Name: %s
Columns: %d
#
" name columns))
    (loop for i on palette
	  by 'cddr
	  do
	  (multiple-value-bind (r g b)(css-color-hex-to-rgb
				       (css-color-hexify-anystring (cadr i)))
	    (insert (format "%3d %3d %3d\t%s\n"
			    r g b
			    (car i))))))
  (if (featurep 'gpl)
      (gpl-mode)))

(provide 'css-palette)
;; css-palette.el ends here