;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               pjb-xcode.el
;;;;LANGUAGE:           emacs lisp
;;;;SYSTEM:             POSIX
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;    Loads a Xcode DVT theme plist and set the font-lock face colors from it.
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pbourguignon@dxo.com>
;;;;MODIFICATIONS
;;;;    2013-04-12 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal Bourguignon 2013 - 2013
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
;;;;    it under the terms of the GNU Affero 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 Affero General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(require 'pjb-xml)
(require 'color)



(defun plist-object-to-lisp (pobject)
  (when (atom pobject)
    (error "Unexpected plist object %S" object))
  (case (car pobject)
    ((dict)    (loop
                  for (key value) on (cddr pobject) by (function cddr)
                  collect (cons (plist-object-to-lisp key)
                                (plist-object-to-lisp value))))
    ((key)     (intern (format ":%s" (third pobject))))
    ((string)  (third pobject))
    (otherwise (error "Unsupported plist object type %s" (car pobject)))))

(defun plist-to-lisp (plist)
  (assert (and (listp plist) (eq 'plist (first plist))))
  (let ((version (cdr (assoc 'version (second plist)))))
   (unless (string= "1.0" version)
     (error "Unsupported plist version %S" version)))
  (plist-object-to-lisp (third plist)))


(defun parse-color (color)
  "`color' contains the RGBA values as floating point numbers between 0 and 1. Return them in a list."
  (first (read-from-string (format "(%s)" color))))

(assert (equalp (parse-color "0.338151 0.602653 1 1") '(0.338151 0.602653 1 1)))

(defvar *map-xcode-syntax-to-faces*
  '((font-lock-builtin-face                . :xcode.syntax.identifier.function.system)
    (font-lock-comment-delimiter-face      . :xcode.syntax.comment)
    (font-lock-comment-face                . :xcode.syntax.comment)
    (font-lock-constant-face               . :xcode.syntax.identifier.constant)
    (font-lock-doc-face                    . :xcode.syntax.comment.doc)
    (font-lock-function-name-face          . :xcode.syntax.identifier.function)
    (font-lock-keyword-face                . :xcode.syntax.keyword)
    (font-lock-preprocessor-face           . :xcode.syntax.preprocessor)
    (font-lock-string-face                 . :xcode.syntax.string)
    (font-lock-type-face                   . :xcode.syntax.identifier.type)
    (font-lock-variable-name-face          . :xcode.syntax.identifier.variable)
    (default                               . :xcode.syntax.plain)))

(defun load-faces-from-xcode-dvtcolortheme (path)
  (let* ((theme        (plist-to-lisp  (xml-remove-blank-elements (first (xml-parse-file path)))))
         (xcode-colors (assoc :DVTSourceTextSyntaxColors theme)))
    (loop
       for (face . key) in *map-xcode-syntax-to-faces*
       for xcode-color = (cdr (assoc key xcode-colors))
       when xcode-color
       do (let ((color (apply (function color-rgb-to-hex) (subseq (parse-color xcode-color) 0 3))))
            (set-face-foreground face color)))))

(provide 'pjb-xcode)