emacs/nxhtml/util/css-palette.el

   1 ;;; css-palette.el
   2
   3 (defconst css-palette:version "0.02")
   4 ;; Copyright (C) 2008 Niels Giesen
   5
   6 ;; Author: Niels Giesen <nielsforkgiesen@gmailspooncom, but please
   7 ;; replace the kitchen utensils with a dot before hitting "Send">
   8 ;; Keywords: processes, css, multimedia, extensions, tools
   9 ;; Homepage: http://niels.kicks-ass.org/
  10
  11 ;; This program is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; css-palette defines commands to have "palettes" inside a block
  27 ;; comment to circumvent the absence of (color or other) variable
  28 ;; definitions in the CSS specification. It can import and export GIMP
  29 ;; color palettes. See the documentation of `css-palette-mode'
  30 ;; for details of usage.
  31
  32 ;;; Installation:
  33
  34 ;; Something like:
  35
  36 ;; put it in your load-path.
  37
  38 ;; (autoload 'css-palette-mode "css-palette" "" t)
  39 ;; (add-hook 'css-mode-hook
  40 ;;        (lambda ()
  41 ;;          (css-palette-mode t)))
  42
  43 ;; Notes:
  44
  45 ;; css-palette depends on css-color.el to do font-locking.
  46
  47 ;; ccs-palette is orthogonal to css-mode, so it could probably be used
  48 ;; inside other language modes, provided they support multiline block
  49 ;; comments.
  50
  51 ;;; Change log:
  52
  53 ;; 2009-01-11 Lennart Borgman
  54 ;;   - Minor code clean up.
  55
  56 ;;; Code:
  57 (require 'css-color)
  58 (eval-when-compile (require 'cl))               ;i'm a bad bad boy...
  59
  60 (defconst css-palette-hex-chars "0123456789abcdefABCDEF"
  61   "Composing chars in hexadecimal notation, save for the hash (#) sign.")
  62
  63 (defvar css-palette-mode-map
  64   (let ((m (make-sparse-keymap)))
  65     (define-key m "\C-c\C-c" 'css-palette-update-all)
  66     (define-key m "\C-c\C-i" 'css-palette-insert-reference)
  67     (define-key m "\C-c\C-p" 'css-palette-import-from-GIMP)
  68     (define-key m "\C-c\C-f" 'css-palette-insert-files)
  69     m)
  70   "Mode map for `css-palette-mode'")
  71
  72 ;;;###autoload
  73 (define-minor-mode css-palette-mode
  74   "Minor mode for palettes in CSS.
  75
  76 The mode `css-palette-mode' acts on the first COLORS declaration in your
  77   file of the form:
  78
  79 COLORS:
  80 \(
  81 c0 \"#6f5d25\"  ;tainted sand
  82 c1 \"#000000\"  ;Black
  83 c2 \"#cca42b\"  ;goldenslumber
  84 c3 \"#6889cb\"  ;far off sky
  85 c4 \"#fff\"     ;strange aeons
  86 )
  87
  88 Such declarations should appear inside a block comment, in order
  89   to be parsed properly by the LISP reader.
  90
  91 Type \\[css-palette-update-all], and any occurence of
  92
  93   color: #f55; /*[c3]*/
  94
  95 will be updated with
  96
  97   color: #6899cb; /*[c3]*/
  98
  99 The following commands are available to insert key-value pairs
 100   and palette declarations:
 101   \\{css-palette-mode-map}
 102
 103 You can extend or redefine the types of palettes by defining a
 104   new palette specification of the form (PATTERN REGEXP
 105   REF-FOLLOWS-VALUE), named according to the naming scheme
 106   css-palette:my-type, where
 107
 108 PATTERN is a pattern containing two (%s) format directives which
 109   will be filled in with the variable and its value,
 110
 111 REGEXP is a regular expression to match a value - variable
 112   pattern,
 113
 114 and REF-FOLLOWS-VALUE defined whether or not the reference comes
 115   after the value. This allows for more flexibility.
 116
 117 Note that, although the w3c spec at URL
 118   `http://www.w3.org/TR/CSS2/syndata.html#comments' says that
 119   comments \" may occur anywhere between tokens, and their
 120   contents have no influence on the rendering\", Internet
 121   Explorer does not think so. Better keep all your comments after
 122   a \"statement\", as per the default. This means `css-palette'
 123   is ill-suited for use within shorthands.
 124
 125 See variable `css-palette:colors' for an example of a palette
 126   type.
 127
 128 The extension mechanism means that palette types can be used to
 129   contain arbitrary key-value mappings.
 130
 131 Besides the colors palette, css-palette defines the palette
 132   definition variables `css-palette:colors-outside' and
 133   `css-palette:files', for colors with the reference outside and
 134   for file url()'s respectively.
 135
 136 You can fine-control which palette types css-palette should look
 137   at via the variable `css-palette-types'.
 138
 139 "
 140   nil
 141   "-palette"
 142   css-palette-mode-map
 143   (css-color-mode +1))
 144
 145 ;;;###autoload
 146 (defgroup css-palette nil
 147   "Customization group for css-palette library.
 148
 149 See function `css-palette-mode' for documentation"
 150   :group 'css-color)
 151
 152 (defcustom css-palette:colors
 153   `("%s; /*[%s]*/ "
 154     ,(concat "\\("
 155              css-color-color-re
 156 ;;            (mapconcat
 157 ;;             'identity
 158 ;;             (list css-color-hex-re
 159 ;;                   css-color-hsl-re
 160 ;;                   css-color-rgb-re) "\\|")
 161               "\\)"
 162               "[[:space:]]*;[[:space:]]*\/\\*\\[\\([^[:space:]]+\\)\\]\\*\/")
 163     t)
 164   "Color palette specification.
 165
 166 See function `css-palette-mode' for documentation"
 167   :group 'css-palette
 168   :type '(list
 169           (string :tag "Pattern")
 170           (regexp :tag "Regexp")
 171           (boolean :tag "Reversed")))
 172
 173 (defcustom css-palette:files
 174   '("url(%s); /*[%s]*/ "
 175     "url(\\([^)]+\\))[[:space:]]*;[[:space:]]*\/\\*\\[\\([^[:space:]]+\\)\\]\\*\/"
 176     t)
 177   "File palette specification.
 178
 179 See function `css-palette-mode' for documentation"
 180   :group 'css-palette
 181   :type '(list
 182           (string :tag "Pattern")
 183           (regexp :tag "Regexp")
 184           (boolean :tag "Reversed")))
 185
 186 (defcustom css-palette-types
 187   '(colors)
 188   "List of palette types to check for in buffer.
 189
 190 See function `css-palette-mode' for documentation"
 191   :group 'css-palette
 192   :type '(repeat (symbol :tag "Palette type")))
 193 (make-variable-buffer-local 'css-palette-types)
 194
 195 ;; (defun css-palette-mode-turn-on ()
 196 ;;   "Turn on `css-palette-mode'."
 197 ;;   (css-palette-mode 1))
 198
 199 ;; ;;;###autoload
 200 ;; (defcustom css-palette-mode-activate-p nil
 201 ;; "Start `css-palette-mode' when `css-mode' is activated."
 202 ;;   :group 'css-palette
 203 ;;   :set (lambda (sym val)
 204 ;;          (set-default sym val)
 205 ;;          (if val
 206 ;;              (add-hook 'css-mode-hook 'css-palette-mode-turn-on)
 207 ;;            (remove-hook 'css-mode-hook 'css-palette-mode-turn-on)))
 208 ;;   :type 'boolean)
 209
 210 (defun css-palette-turn-on-in-buffer ()
 211   "Turn on `css-palette-mode' in `css-mode'."
 212   (when (derived-mode-p 'css-mode)
 213     (message "turn-on-in-b:before (css-palette-mode 1) cb=%s" (current-buffer))
 214     (css-palette-mode 1)
 215     (message "turn-on-in-b:after (css-palette-mode 1)")
 216     ))
 217
 218 ;;;###autoload
 219 (define-globalized-minor-mode css-palette-global-mode css-palette-mode
 220   css-palette-turn-on-in-buffer
 221   :group 'css-color)
 222
 223 (defun css-palette-get (key spec)
 224   (plist-get
 225    (css-palette-spec-to-plist
 226     (symbol-value
 227      (intern-soft
 228       (format "css-palette:%s" spec)))) key))
 229
 230 (defun css-palette-spec-to-plist (palette)
 231   (destructuring-bind (pattern regexp ref-follows-value) palette
 232     (list :regexp regexp
 233           :pattern pattern
 234           :ref-follows-value ref-follows-value)))
 235
 236 (defun css-palette-choose-type ()
 237   (intern-soft
 238    (if (null (cdr css-palette-types))
 239        (car css-palette-types)
 240      (completing-read "Type: "
 241                       (mapcar 'symbol-name css-palette-types)))))
 242
 243 (defun css-palette-get-declaration (type)
 244   "Return `css-palette' declaration of TYPE in current buffer.
 245
 246 If none is found, throw an error."
 247   (let ((type (symbol-name type)))
 248     (save-excursion
 249       (goto-char (point-min))
 250       (or (re-search-forward (format "%s:"
 251                                      (upcase type)) nil t)
 252           (error "No %s declaration found in buffer; check value of variable
 253           `css-palette-types'" type))
 254       (let ((palette (read (current-buffer))))
 255         ;; Check (could be better..)
 256         (if (not (and
 257                   (listp palette)
 258                   (= 0 (% (length palette) 2))))
 259             (error "Invalid %s " type))
 260         palette))))
 261
 262 (defun css-palette-update (type)
 263 "Update buffer references for palette of TYPE."
 264   (interactive (list
 265                 (css-palette-choose-type)))
 266   (let ((palette (css-palette-get-declaration type))
 267         (regexp (css-palette-get :regexp type))
 268         (ref-follows-value (css-palette-get :ref-follows-value type)))
 269     (flet ((getval (key palette)
 270                       (let ((value (plist-get palette (intern-soft key))))
 271                         (if (null value)
 272                             (error
 273                              "%S not specified in %S palette "
 274                              key
 275                              type
 276                              ;;  (signal 'css-palette-not-found-error nil)
 277                              )
 278                           value))))
 279       (save-excursion
 280         (goto-char (point-min))
 281         (while (re-search-forward
 282                 regexp
 283                 (point-max) t)
 284           (replace-match
 285            (getval (match-string-no-properties (if ref-follows-value 2 1)) palette)
 286            nil nil nil (if ref-follows-value 1 2))))))
 287    (css-color-mode 1))
 288
 289 (defun css-palette-update-all ()
 290   "Update all references for palettes in `css-palette-types'"
 291   (interactive)
 292   (catch 'err
 293     (mapc (lambda (type)
 294             (condition-case err
 295                 (css-palette-update type)
 296               (if (y-or-n-p (format "%s, skip? " err))
 297                   nil)))
 298           css-palette-types)))
 299
 300 ;; Reference Insertion
 301 (defun css-palette-insert-reference (type)
 302   "Insert `css-palette' reference of TYPE at point."
 303   (interactive
 304     (list (css-palette-choose-type)))
 305   (let* ((palette (css-palette-get-declaration type))
 306          (ref-follows-value (css-palette-get :ref-follows-value type))
 307          (pattern (css-palette-get :pattern type))
 308          (var
 309           (completing-read (format "%s variable: "
 310                                    (capitalize
 311                                     (substring (symbol-name type)
 312                                                0 -1)))
 313                            (loop for i on
 314                                  palette
 315                                  by 'cddr
 316                                  collect
 317                                  (css-palette-colorify
 318                                   (symbol-name (car i))
 319                                   (cadr i)))))
 320          (val  (plist-get palette (read var))))
 321     (insert (apply 'format
 322                    pattern
 323                    (if ref-follows-value
 324                        (list val var)
 325                      (list var val))))
 326     (css-color-mode +1)))
 327
 328 (defun css-palette-hex-color-p (str)
 329   (string-match "#\\([a-fA-F[:digit:]]\\{6\\}\\|[a-fA-F[:digit:]]\\{3\\}\\)" str))
 330
 331 (defun css-palette-colorify (string color)
 332   (let ((color (if (css-palette-hex-color-p color)
 333                    color
 334                  "#000")))
 335   (propertize string
 336               'font-lock-face
 337               (list :background color
 338                     :foreground (css-color-foreground-color color)
 339                     string)
 340               'fontified t)))
 341
 342 ;; Imports
 343 (defun css-palette-from-existing-colors ()
 344   (interactive)
 345   (let ((palette)
 346         (count -1))
 347     (save-excursion
 348       (goto-char (point-min))
 349       (while (re-search-forward "#[[:digit:]a-fA-F]\\{6\\}\\>" nil t)
 350         (if (not (member (match-string-no-properties 0) palette))
 351             (setq palette (append (list
 352                                    (match-string-no-properties 0)
 353                                    (intern(format "c%d" (incf count))))
 354                                   palette)))
 355         (save-match-data (re-search-forward ";" nil t))
 356         (insert (format "/*[%S]*/" (cadr (member (match-string-no-properties 0) palette))))))
 357     (insert (format "COLORS:\n%S" (nreverse palette)))
 358     (forward-sexp -1)
 359     (forward-char 1)
 360     (while
 361         (not (looking-at ")"))
 362       (forward-sexp 2)
 363       (newline)
 364       (indent-for-tab-command))))
 365
 366 (defun css-palette-newest-GIMP-dir ()
 367   "Return newest (version-wise) ~/.gimp-n.n/palettes directory on disk.
 368
 369 Return `nil' if none such directory is found."
 370   (catch 'none
 371     (concat
 372      (or
 373       (car
 374        (last
 375         (directory-files "~/" t "^.gimp-[[:digit:].]\\{3,\\}")))
 376       (throw 'none ()))
 377    "/palettes/")))
 378
 379 (defun css-palette-import-from-GIMP ()
 380   "Import GIMP palette file as a `css-palette' palette.
 381
 382 GIMP palettes can be made with the GIMP or on-line tools such as
 383 found at URL `http://colourlovers.com'."
 384   (interactive)
 385   (let ((file (read-file-name "File: " (css-palette-newest-GIMP-dir)))
 386         (this-buffer (current-buffer))
 387         (count -1))
 388     (insert "\nCOLORS:\n(\n")
 389     (with-temp-buffer
 390       (insert-file-contents file)
 391       (goto-char (point-min))
 392       (while (re-search-forward
 393               (concat
 394                "^"
 395                "[[:space:]]*\\([[:digit:]]+\\)"  ;red
 396                "[[:space:]]+\\([[:digit:]]+\\)"  ;green
 397                "[[:space:]]+\\([[:digit:]]+\\)"  ;blue
 398                "[[:space:]]+\\(.*\\)$") ;name (=> used as comment)
 399               nil t)
 400         (destructuring-bind (rb re gb ge bb be nb ne &rest ignore)
 401             (cddr (match-data t))
 402           (let ((color
 403                  (apply 'format "c%d \"#%02x%02x%02x\" ;%s\n"
 404                         (incf count)
 405                         (append
 406                          (mapcar 'string-to-number
 407                                  (list
 408                                   (buffer-substring-no-properties rb re)
 409                                   (buffer-substring-no-properties gb ge)
 410                                   (buffer-substring-no-properties bb be)))
 411                          (list (buffer-substring-no-properties nb ne))))))
 412             (with-current-buffer this-buffer
 413               (insert color))))))
 414     (insert ")")
 415     (message "C-c C-c to update colors")))
 416
 417 (defun css-palette-insert-files (dir)
 418   "Insert a `css-palette' declaration for all files in DIR.
 419
 420 Filenames are relative.
 421 Main use-case: an image directory."
 422   (interactive "DDirectory: ")
 423   (save-excursion
 424     (let ((image-count -1))
 425       (insert "\nFILES:\n(\n")
 426       (mapc
 427        (lambda (f)
 428          (insert
 429           (format "file-%d %S\n"
 430                   (incf image-count)
 431                   (file-relative-name
 432                    f
 433                    (file-name-directory (buffer-file-name))))))
 434        (directory-files dir t "...+"))
 435       (insert ")\n\n"))))
 436
 437 ;; Exports
 438 (defun css-palette-export-to-GIMP (type name columns)
 439   "Export the COLORS declaration to a GIMP (.gpl) palette.
 440
 441 See also `gpl-mode' at URL
 442 `http://niels.kicks-ass.org/public/elisp/gpl.el'."
 443   (interactive
 444    (list
 445     (css-palette-choose-type)
 446     (read-string "Name: ")
 447     (read-number "Number of columns: " 2)))
 448   (let ((palette (css-palette-get-declaration type)))
 449     (find-file
 450      (concat (css-palette-newest-GIMP-dir)
 451              name
 452              ".gpl"))
 453     (insert
 454      (format "GIMP Palette
 455 Name: %s
 456 Columns: %d
 457 #
 458 " name columns))
 459     (loop for i on palette
 460           by 'cddr
 461           do
 462           (multiple-value-bind (r g b)(css-color-hex-to-rgb
 463                                        (css-color-hexify-anystring (cadr i)))
 464             (insert (format "%3d %3d %3d\t%s\n"
 465                             r g b
 466                             (car i))))))
 467   (if (featurep 'gpl)
 468       (gpl-mode)))
 469
 470 (provide 'css-palette)
 471 ;; css-palette.el ends here