/[ht-ajax]/jsmin.lisp
ViewVC logotype

Contents of /jsmin.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Fri Nov 14 21:17:43 2008 UTC (5 years, 5 months ago) by xlopez
File size: 8095 byte(s)
Initial commit, version 0.0.7.
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
2 ;;;
3 ;;; Copyright (c) 2007, Ury Marshak
4 ;;; This is a port of original C code by Douglas Crockford to
5 ;;; Common Lisp. There was no attempt to make the code more
6 ;;; "lispy", it is just a rather faithful translation. This code
7 ;;; may be used under the same conditions as the C original, which
8 ;;; has the following copyright notice:
9 ;;;
10 ;;; /* jsmin.c
11 ;;; 2007-01-08
12 ;;;
13 ;;; Copyright (c) 2002 Douglas Crockford (www.crockford.com)
14 ;;;
15 ;;; Permission is hereby granted, free of charge, to any person obtaining a copy of
16 ;;; this software and associated documentation files (the "Software"), to deal in
17 ;;; the Software without restriction, including without limitation the rights to
18 ;;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
19 ;;; of the Software, and to permit persons to whom the Software is furnished to do
20 ;;; so, subject to the following conditions:
21 ;;;
22 ;;; The above copyright notice and this permission notice shall be included in all
23 ;;; copies or substantial portions of the Software.
24 ;;;
25 ;;; The Software shall be used for Good, not Evil.
26 ;;;
27 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
28 ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
29 ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
30 ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
31 ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
32 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
33 ;;; SOFTWARE.
34 ;;; */
35 ;;;
36
37 (in-package #:ht-ajax)
38
39 (declaim #.*optimization*)
40 ;;
41
42 (defun is-alphanum (c)
43 "isAlphanum -- return true if the character is a letter, digit, underscore,
44 dollar sign, or non-ASCII character"
45 (and c
46 (or (and (char>= c #\a) (char<= c #\z))
47 (and (char>= c #\0) (char<= c #\9))
48 (and (char>= c #\A) (char<= c #\Z))
49 (char= c #\_)
50 (char= c #\$)
51 (char= c #\\)
52 (> (char-code c) 126))))
53
54
55
56 (defun %jsmin (in out)
57 (let (the-a the-b the-lookahead (pos 0))
58 (labels ((get-c ()
59 ;; return the next character from stdin. Watch out for lookahead. If
60 ;; the character is a control character, translate it to a space or
61 ;; linefeed.
62 (let ((c the-lookahead))
63 (setf the-lookahead nil)
64 (unless c
65 (setf c (read-char in nil nil))
66 (incf pos))
67 (cond
68 ((or (null c)
69 (char= c #\Newline)
70 (char>= c #\Space)) c)
71 ((char= c (code-char 13)) #\Newline)
72 (t #\Space))))
73
74 (peek ()
75 ;; get the next character without getting it
76 (setf the-lookahead (get-c)))
77
78 (next ()
79 ;; get the next character, excluding comments. peek()
80 ;; is used to see if a '/' is followed by a '/' or '*'.
81 (let ((c (get-c)))
82 (if (and c
83 (char= c #\/))
84 (case (peek)
85 (#\/
86 (loop for cc = (get-c)
87 while (and cc
88 (char> cc #\Newline))
89 finally (return cc)))
90 (#\*
91 (get-c)
92 (loop for cc = (get-c)
93 unless cc
94 do (error "JSMIN: Unterminated comment.")
95 when (and (char= cc #\*)
96 (char= (peek) #\/))
97 do (progn (get-c) (return #\Space))))
98 (otherwise
99 c))
100 c)))
101
102
103 (action (d)
104 ;; action -- do something! What you do is determined by the argument:
105 ;; 1 Output A. Copy B to A. Get the next B.
106 ;; 2 Copy B to A. Get the next B. (Delete A).
107 ;; 3 Get the next B. (Delete B).
108 ;; action treats a string as a single character. Wow!
109 ;; action recognizes a regular expression if it is
110 ;; preceded by ( or , or =.
111
112
113 (when (= d 1)
114 (write-char the-a out))
115 (when (<= d 2)
116 (setf the-a the-b)
117 (when (and the-a
118 (or (char= the-a #\')
119 (char= the-a #\")))
120 (loop
121 (progn
122 (write-char the-a out)
123 (setf the-a (get-c))
124 (when (and the-a (char= the-a the-b))
125 (return))
126 (when (or (null the-a)
127 (char<= the-a #\Newline))
128 (error "JSMIN unterminated string literal: ~C at position ~A" the-b pos))
129 (when (char= the-a #\\)
130 (write-char the-a out)
131 (setf the-a (get-c)))))))
132 (when (<= d 3)
133 (setf the-b (next))
134 (when (and the-b
135 (char= the-b #\/)
136 (position the-a "(,=:[!&|?"))
137 (write-char the-a out)
138 (write-char the-b out)
139 (loop
140 (progn
141 (setf the-a (get-c))
142 (when (and the-a
143 (char= the-a #\/))
144 (return))
145 (when (and the-a
146 (char= the-a #\\))
147 (write-char the-a out)
148 (setf the-a (get-c)))
149 (when (or (null the-a)
150 (char<= the-a #\Newline))
151 (error "JSMIN: unterminated Regular Expression literal."))
152 (write-char the-a out)))
153 (setf the-b (next))))))
154 ;; jsmin -- Copy the input to the output, deleting the characters
155 ;; which are insignificant to JavaScript. Comments will be
156 ;; removed. Tabs will be replaced with spaces. Carriage returns will
157 ;; be replaced with linefeeds. Most spaces and linefeeds will be
158 ;; removed.
159 (setf the-a #\Newline)
160 (action 3)
161 (loop while the-a
162 do (case the-a
163 (#\Space
164 (if (is-alphanum the-b)
165 (action 1)
166 (action 2)))
167 (#\Newline
168 (case the-b
169 ((#\{ #\[ #\( #\+ #\-)
170 (action 1))
171 (#\Space
172 (action 3))
173 (otherwise
174 (if (is-alphanum the-b)
175 (action 1)
176 (action 2)))))
177 (otherwise
178 (case the-b
179 (#\Space
180 (if (is-alphanum the-a)
181 (action 1)
182 (action 3)))
183 (#\Newline
184 (case the-a
185 ((#\} #\] #\) #\+ #\- #\" #\')
186 (action 1))
187 (otherwise
188 (if (is-alphanum the-a)
189 (action 1)
190 (action 3)))))
191 (otherwise
192 (action 1))))))
193 )))
194
195
196 (defun jsmin (js)
197 (with-output-to-string (out)
198 (with-input-from-string (in js)
199 (%jsmin in out))))
200
201 (defun jsmin-file (infile outfile)
202 (with-open-file (in infile :direction :input)
203 (with-open-file (out outfile :direction :output :if-exists :overwrite
204 :if-does-not-exist :create)
205 (%jsmin in out))))

  ViewVC Help
Powered by ViewVC 1.1.5