Permalink
Browse files

Add CL compat layer, fix remaining byte compilation issues

  • Loading branch information...
1 parent ff9f9f9 commit 40e90bf950da6cbf57e3a74acaf94b4809700bc7 @jscheid committed Sep 24, 2012
Showing with 740 additions and 632 deletions.
  1. +1 −0 Makefile
  2. +11 −11 kite-breakpoint.el
  3. +62 −0 kite-cl.el
  4. +90 −86 kite-color.el
  5. +5 −133 kite-console.el
  6. +19 −16 kite-debug.el
  7. +4 −0 kite-dom-css.el
  8. +202 −197 kite-dom.el
  9. +11 −3 kite-global.el
  10. +10 −5 kite-load-path.el
  11. +2 −0 kite-modeline.el
  12. +7 −4 kite-net.el
  13. +17 −10 kite-object.el
  14. +1 −0 kite-scratch.el
  15. +89 −86 kite-sourcemap.el
  16. +11 −11 kite-tests.el
  17. +151 −25 kite-util.el
  18. +47 −45 kite.el
View
@@ -23,6 +23,7 @@ all: kite.tar.gz kite.html
ELISP_SOURCES = \
kite-breakpoint.el \
+ kite-cl.el \
kite-color.el \
kite-console.el \
kite-debug.el \
View
@@ -32,19 +32,21 @@
;;; Code:
+(require 'kite-cl)
(require 'kite-global)
+(require 'ewoc)
(require 'browse-url nil t)
-(defstruct
+(kite--defstruct
(kite-breakpoint
(:constructor nil)) ; no default constructor
to-string-function
set-function
remove-function
sort-priority)
-(defstruct
+(kite--defstruct
(kite-next-instruction-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -68,7 +70,7 @@
"Remove a breakpoint of type `next-instruction'"
(kite-send "Debugger.resume" :success-function response-handler))
-(defstruct
+(kite--defstruct
(kite-all-exceptions-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -89,7 +91,7 @@
:params '(:state "all")
:success-function response-handler))
-(defstruct
+(kite--defstruct
(kite-uncaught-exceptions-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -117,7 +119,7 @@
;; Location breakpoints
-(defstruct
+(kite--defstruct
(kite-location-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -136,7 +138,7 @@
;; DOM Node breakpoints
-(defstruct
+(kite--defstruct
(kite-dom-node-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -180,7 +182,7 @@
;; DOM Event breakpoints
-(defstruct
+(kite--defstruct
(kite-dom-event-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -212,7 +214,7 @@
;; Instrumentation breakpoints
-(defstruct
+(kite--defstruct
(kite-instrumentation-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -244,7 +246,7 @@
;; XHR breakpoints
-(defstruct
+(kite--defstruct
(kite-xhr-breakpoint
(:include kite-breakpoint)
(:constructor nil) ; no default constructor
@@ -379,10 +381,8 @@
breakpoint))))
(ewoc-invalidate breakpoint-ewoc)))
(lexical-let ((new-breakpoint (make-kite-next-instruction-breakpoint)))
- (message "setting breakpoint")
(kite--set-breakpoint new-breakpoint
(lambda (result)
- (message "breakpoint set")
(kite--add-breakpoint breakpoint-ewoc new-breakpoint)
(ewoc-invalidate breakpoint-ewoc)))))))
View
@@ -0,0 +1,62 @@
+;;; kite-net.el --- Temporary Kite Common Lisp adaptor
+
+;; Copyright (C) 2012 Julian Scheid
+
+;; Author: Julian Scheid <julians37@gmail.com>
+;; Keywords: tools
+;; Package: kite
+;; Compatibility: GNU Emacs 24
+
+;; This file is not part of GNU Emacs.
+
+;; Kite 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.
+
+;; Kite 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 Kite. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides aliases to smooth out the differences between
+;; cl and cl-lib. It is intended to be temporary, to be removed once
+;; cl-lib is available widely.
+;;
+;; It is part of Kite, a WebKit inspector front-end.
+
+
+;;; Code:
+
+(if (require 'cl-lib nil t)
+ (progn
+ (defalias 'kite--defstruct 'cl-defstruct)
+ (defalias 'kite--defun 'cl-defun)
+ (defalias 'kite--every 'cl-every)
+ (defalias 'kite--find-if 'cl-find-if)
+ (defalias 'kite--flet 'cl-flet)
+ (defalias 'kite--incf 'cl-incf)
+ (defalias 'kite--mapcar 'cl-mapcar)
+ (defalias 'kite--position 'cl-position)
+ (defalias 'kite--remove-if 'cl-remove-if)
+ (defalias 'kite--subseq 'cl-subseq))
+ (require 'cl)
+ (defalias 'kite--defstruct 'defstruct)
+ (defalias 'kite--defun 'defun*)
+ (defalias 'kite--every 'every)
+ (defalias 'kite--find-if 'find-if)
+ (defalias 'kite--flet 'flet)
+ (defalias 'kite--incf 'incf)
+ (defalias 'kite--mapcar 'mapcar*)
+ (defalias 'kite--position 'position)
+ (defalias 'kite--remove-if 'remove-if)
+ (defalias 'kite--subseq 'subseq))
+
+(provide 'kite-cl)
+
+;;; kite-cl.el ends here
View
@@ -33,18 +33,19 @@
;;; Code:
+(require 'kite-cl)
(require 'color)
(eval-when-compile
- (require 'cl)
(require 'rx))
-(defun* kite--make-color-image (rgba-float-color
- &key
- (width 16)
- (height 16)
- (checker-size 8)
- (bg-color-1 (color-hsl-to-rgb 0 0 1))
- (bg-color-2 (color-hsl-to-rgb 0 0 0.5)))
+(kite--defun kite--make-color-image
+ (rgba-float-color
+ &key
+ (width 16)
+ (height 16)
+ (checker-size 8)
+ (bg-color-1 (color-hsl-to-rgb 0 0 1))
+ (bg-color-2 (color-hsl-to-rgb 0 0 0.5)))
"Return an image that visualizes the given RGBA-FLOAT-COLOR,
which should be a list containing four float values in the range
0..1.
@@ -71,10 +72,10 @@ for the checkerboard tiles."
(mod (/ row checker-size) 2))
bg-color-list)))
(dolist (component
- (mapcar* (lambda (fg bg)
- (+ (* fg alpha)
- (* bg (- 1 alpha))))
- rgba-float-color bg-color))
+ (kite--mapcar (lambda (fg bg)
+ (+ (* fg alpha)
+ (* bg (- 1 alpha))))
+ rgba-float-color bg-color))
(princ (format "%d " (round (* scale component)))))
(setq column (1+ column)))))
(princ "\n")
@@ -410,80 +411,83 @@ four float values in the range 0..1 corresponding to red, green,
blue, and alpha otherwise. This function does not deal in color
spaces or color profiles and thus its result should be treated as
a 'raw' color value."
- (flet ((clamp (n)
- (max 0.0 (min 1.0 n)))
- (color-hue-to-rgb (v1 v2 h)
- (cond
- ((< h 0) (setq h (+ h 1)))
- ((> h 1) (setq h (- h 1))))
- (cond
- ((< h (/ 1.0 6))
- (+ v1 (* (- v2 v1) h 6.0)))
- ((< h 0.5)
- v2)
- ((< h (/ 2.0 3))
- (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0)))
- (t
- v1))))
- (cond
-
- ;; color keyword
- ((match-string 1 string)
- (gethash (match-string 1 string) (eval-when-compile kite--color-keywords)))
-
- ;; #FFFFFF
- ((match-string 2 string)
- (color-name-to-rgb (match-string 2 string)))
-
- ;; #FFF
- ((match-string 3 string)
- (let ((match (match-string 3 string)))
- (list (/ (hexrgb-hex-to-int (substring match 1 2)) 15.0)
- (/ (hexrgb-hex-to-int (substring match 2 3)) 15.0)
- (/ (hexrgb-hex-to-int (substring match 3 4)) 15.0))))
-
- ;; rgb(n,n,n)
- ((match-string 4 string)
- (list (clamp (/ (string-to-number (match-string 4 string)) 255.0))
- (clamp (/ (string-to-number (match-string 5 string)) 255.0))
- (clamp (/ (string-to-number (match-string 6 string)) 255.0))))
-
- ;; rgb(n%,n%,n%)
- ((match-string 7 string)
- (list (clamp (/ (string-to-number (match-string 7 string)) 100.0))
- (clamp (/ (string-to-number (match-string 8 string)) 100.0))
- (clamp (/ (string-to-number (match-string 9 string)) 100.0))))
-
- ;; rgba(n,n,n,a)
- ((match-string 10 string)
- (list (clamp (/ (string-to-number (match-string 10 string)) 255.0))
- (clamp (/ (string-to-number (match-string 11 string)) 255.0))
- (clamp (/ (string-to-number (match-string 12 string)) 255.0))
- (clamp (string-to-number (match-string 13 string)))))
-
- ;; rgba(n%,n%,n%,a)
- ((match-string 14 string)
- (list (clamp (/ (string-to-number (match-string 14 string)) 100.0))
- (clamp (/ (string-to-number (match-string 15 string)) 100.0))
- (clamp (/ (string-to-number (match-string 16 string)) 100.0))
- (clamp (string-to-number (match-string 17 string)))))
-
- ;; hsl(n,n%,n%)
- ((match-string 18 string)
- (color-hsl-to-rgb
- (mod (/ (string-to-number (match-string 18 string)) 360.0) 1.0)
- (clamp (/ (string-to-number (match-string 19 string)) 100.0))
- (clamp (/ (string-to-number (match-string 20 string)) 100.0))))
-
- ;; hsla(n,n%,n%,a)
- ((match-string 21 string)
- (append
- (color-hsl-to-rgb
- (mod (/ (string-to-number (match-string 21 string)) 360.0) 1.0)
- (clamp (/ (string-to-number (match-string 22 string)) 100.0))
- (clamp (/ (string-to-number (match-string 23 string)) 100.0)))
- (list
- (clamp (string-to-number (match-string 24 string)))))))))
+ (kite--flet
+ ((clamp (n)
+ (max 0.0 (min 1.0 n)))
+ (color-hue-to-rgb (v1 v2 h)
+ (cond
+ ((< h 0) (setq h (+ h 1)))
+ ((> h 1) (setq h (- h 1))))
+ (cond
+ ((< h (/ 1.0 6))
+ (+ v1 (* (- v2 v1) h 6.0)))
+ ((< h 0.5)
+ v2)
+ ((< h (/ 2.0 3))
+ (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0)))
+ (t
+ v1))))
+ (cond
+
+ ;; color keyword
+ ((match-string 1 string)
+ (gethash (match-string 1 string) (eval-when-compile kite--color-keywords)))
+
+ ;; #FFFFFF
+ ((match-string 2 string)
+ (color-name-to-rgb (match-string 2 string)))
+
+ ;; #FFF
+ ((match-string 3 string)
+ (let ((match (match-string 3 string)))
+ (list (/ (string-to-number (substring match 1 2) 16) 15.0)
+ (/ (string-to-number (substring match 2 3) 16) 15.0)
+ (/ (string-to-number (substring match 3 4) 16) 15.0))))
+
+ ;; rgb(n,n,n)
+ ((match-string 4 string)
+ (list (clamp (/ (string-to-number (match-string 4 string)) 255.0))
+ (clamp (/ (string-to-number (match-string 5 string)) 255.0))
+ (clamp (/ (string-to-number (match-string 6 string)) 255.0))))
+
+ ;; rgb(n%,n%,n%)
+ ((match-string 7 string)
+ (list (clamp (/ (string-to-number (match-string 7 string)) 100.0))
+ (clamp (/ (string-to-number (match-string 8 string)) 100.0))
+ (clamp (/ (string-to-number (match-string 9 string)) 100.0))))
+
+ ;; rgba(n,n,n,a)
+ ((match-string 10 string)
+ (list (clamp (/ (string-to-number (match-string 10 string)) 255.0))
+ (clamp (/ (string-to-number (match-string 11 string)) 255.0))
+ (clamp (/ (string-to-number (match-string 12 string)) 255.0))
+ (clamp (string-to-number (match-string 13 string)))))
+
+ ;; rgba(n%,n%,n%,a)
+ ((match-string 14 string)
+ (list (clamp (/ (string-to-number (match-string 14 string)) 100.0))
+ (clamp (/ (string-to-number (match-string 15 string)) 100.0))
+ (clamp (/ (string-to-number (match-string 16 string)) 100.0))
+ (clamp (string-to-number (match-string 17 string)))))
+
+ ;; hsl(n,n%,n%)
+ ((match-string 18 string)
+ (mapcar #'clamp
+ (color-hsl-to-rgb
+ (mod (/ (string-to-number (match-string 18 string)) 360.0) 1.0)
+ (clamp (/ (string-to-number (match-string 19 string)) 100.0))
+ (clamp (/ (string-to-number (match-string 20 string)) 100.0)))))
+
+ ;; hsla(n,n%,n%,a)
+ ((match-string 21 string)
+ (append
+ (mapcar #'clamp
+ (color-hsl-to-rgb
+ (mod (/ (string-to-number (match-string 21 string)) 360.0) 1.0)
+ (clamp (/ (string-to-number (match-string 22 string)) 100.0))
+ (clamp (/ (string-to-number (match-string 23 string)) 100.0))))
+ (list
+ (clamp (string-to-number (match-string 24 string)))))))))
(defun kite-parse-color (string)
(when (let ((case-fold-search nil))
Oops, something went wrong.

0 comments on commit 40e90bf

Please sign in to comment.