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

Contents of /jsmin.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide 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 xlopez 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