There are some examples of lsp2html in action. These examples are from various GNU programs that include a lisp engine, like The GIMP, emacs, octave and Siag. Also, I include an AutoLISP sample of my authorship.
1: ; The GIMP -- an image manipulation program
2: ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
3: ;
4: ; Make-Brush - a script for the script-fu program
5: ; by Seth Burgess 1997 <sjburges@ou.edu>
6: ;
7: ; This program is free software you can redistribute it and/or modify
8: ; it under the terms of the GNU General Public License as published by
9: ; the Free Software Foundation either version 2 of the License, or
10: ; (at your option) any later version.
11: ;
12: ; This program is distributed in the hope that it will be useful,
13: ; but WITHOUT ANY WARRANTY without even the implied warranty of
14: ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: ; GNU General Public License for more details.
16: ;
17: ; You should have received a copy of the GNU General Public License
18: ; along with this program if not, write to the Free Software
19: ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
21:
22: (define (script-fu-make-brush-rectangular description width height spacing )
23: (begin
24: (let* (
25: (img (car (gimp-image-new width height GRAY)))
26: (drawable (car (gimp-layer-new img width height GRAY_IMAGE "MakeBrush" 100 NORMAL)))
27:
28: ; Save old foregound and background colors
29:
30: (old-fg-color (car (gimp-palette-get-foreground)))
31: (old-bg-color (car (gimp-palette-get-background)))
32:
33: ; construct variables
34:
35: (data-dir (car (gimp-gimprc-query "gimp_dir")))
36: (filename (string-append data-dir
37: "/brushes/r"
38: (number->string width)
39: "x"
40: (number->string height)
41: ".gbr")
42: )
43: (desc (string-append description " "
44: (number->string width)
45: "x"
46: (number->string height)
47: )
48: )
49: )
50:
51: (gimp-image-disable-undo img)
52: (gimp-image-add-layer img drawable 0)
53:
54: ; Actual code starts...
55: (gimp-palette-set-background '(0 0 0))
56: (gimp-drawable-fill drawable BG-IMAGE-FILL)
57: (gimp-palette-set-background '(255 255 255))
58: (gimp-rect-select img 0 0 width height REPLACE FALSE 0)
59:
60: (gimp-edit-fill img drawable)
61: (file-gbr-save 1 img drawable filename "" spacing desc)
62:
63: (gimp-brushes-refresh)
64: (gimp-brushes-set-brush desc)
65:
66: ; Terminate, restoring old bg.
67:
68: (gimp-selection-none img)
69: (gimp-palette-set-foreground old-fg-color)
70: (gimp-palette-set-background old-bg-color)
71: (gimp-image-enable-undo img)
72: (gimp-image-delete img)
73: )
74: )
75: )
76:
77: ; Register with the PDB
78:
79: (script-fu-register "script-fu-make-brush-rectangular"
80: "<Toolbox>/Xtns/Script-Fu/Make Brush/Rectangular"
81: "Create size of brush"
82: "Seth Burgess <sjburges@ou.edu>"
83: "Seth Burgess"
84: "1997"
85: ""
86: SF-VALUE "Description" "\"Rectangle\""
87: SF-VALUE "Width" "20"
88: SF-VALUE "Height" "20"
89: SF-VALUE "Spacing" "20"
90: )
91:
92:
93: (define (script-fu-make-brush-rectangular-feathered description width height feathering spacing)
94: (begin
95: (let* (
96: (widthplus (+ width feathering))
97: (heightplus (+ height feathering))
98: (img (car (gimp-image-new widthplus heightplus GRAY)))
99: (drawable (car (gimp-layer-new img widthplus heightplus GRAY_IMAGE "MakeBrush" 100 NORMAL)))
100:
101: ; Save old foregound and background colors
102:
103: (old-fg-color (car (gimp-palette-get-foreground)))
104: (old-bg-color (car (gimp-palette-get-background)))
105:
106: (data-dir (car (gimp-gimprc-query "gimp_dir")))
107: (filename (string-append data-dir
108: "/brushes/r"
109: (number->string width)
110: "x"
111: (number->string height)
112: "f"
113: (number->string feathering)
114: ".gbr")
115: )
116: (desc (string-append description " "
117: (number->string width)
118: "x"
119: (number->string height)
120: ","
121: (number->string feathering)
122: )
123: )
124: )
125:
126: (gimp-image-disable-undo img)
127: (gimp-image-add-layer img drawable 0)
128:
129: ; Actual code starts...
130: (gimp-palette-set-background '(0 0 0))
131: (gimp-drawable-fill drawable BG-IMAGE-FILL)
132: (gimp-palette-set-background '(255 255 255))
133: (cond ((< 0 feathering)
134: (gimp-rect-select img (/ feathering 2) (/ feathering 2) width height REPLACE TRUE feathering))
135: ((>= 0 feathering)
136: (gimp-rect-select img 0 0 width height REPLACE FALSE 0))
137: )
138: (gimp-edit-fill img drawable)
139: (file-gbr-save 1 img drawable filename "" 25 desc)
140:
141: (gimp-brushes-refresh)
142: (gimp-brushes-set-brush desc)
143:
144: ; Terminate, restoring old bg.
145:
146: (gimp-selection-none img)
147: (gimp-palette-set-foreground old-fg-color)
148: (gimp-palette-set-background old-bg-color)
149: (gimp-image-enable-undo img)
150: (gimp-image-delete img)
151: )
152: )
153: )
154:
155: ; Register with the PDB
156:
157: (script-fu-register "script-fu-make-brush-rectangular-feathered"
158: "<Toolbox>/Xtns/Script-Fu/Make Brush/Rectangular, Feathered"
159: "Create size of brush"
160: "Seth Burgess <sjburges@ou.edu>"
161: "Seth Burgess"
162: "1997"
163: ""
164: SF-VALUE "Description" "\"Rectangle\""
165: SF-VALUE "Width" "20"
166: SF-VALUE "Height" "20"
167: SF-VALUE "Feathering" "4"
168: SF-VALUE "Spacing" "25"
169: )
170:
171: (define (script-fu-make-brush-elliptical description width height spacing)
172: (begin
173: (let* (
174: (img (car (gimp-image-new width height GRAY)))
175: (drawable (car (gimp-layer-new img width height GRAY_IMAGE "MakeBrush" 100 NORMAL)))
176:
177: ; Save old foregound and background colors
178:
179: (old-fg-color (car (gimp-palette-get-foreground)))
180: (old-bg-color (car (gimp-palette-get-background)))
181:
182: ; Construct variables...
183:
184: (data-dir (car (gimp-gimprc-query "gimp_dir")))
185: (filename (string-append data-dir
186: "/brushes/e"
187: (number->string width)
188: "x"
189: (number->string height)
190: ".gbr"))
191: (desc (string-append description " "
192: (number->string width)
193: "x"
194: (number->string height)
195: )
196: )
197: )
198: ; End of variables. Couple of necessary things here.
199:
200: (gimp-image-disable-undo img)
201: (gimp-image-add-layer img drawable 0)
202:
203: ; Actual code starts...
204: (gimp-palette-set-background '(0 0 0))
205: (gimp-drawable-fill drawable BG-IMAGE-FILL)
206: (gimp-palette-set-background '(255 255 255))
207: (gimp-ellipse-select img 0 0 width height REPLACE TRUE FALSE 0)
208:
209: (gimp-edit-fill img drawable)
210: (file-gbr-save 1 img drawable filename "" spacing desc)
211:
212: (gimp-brushes-refresh)
213: (gimp-brushes-set-brush desc)
214:
215: ; Terminate, restoring old bg.
216:
217: (gimp-selection-none img)
218: (gimp-palette-set-foreground old-fg-color)
219: (gimp-palette-set-background old-bg-color)
220: (gimp-image-enable-undo img)
221: (gimp-image-delete img)
222: )
223: )
224: )
225:
226: ; Register with the PDB
227:
228: (script-fu-register "script-fu-make-brush-elliptical"
229: "<Toolbox>/Xtns/Script-Fu/Make Brush/Elliptical"
230: "Create size of brush"
231: "Seth Burgess <sjburges@ou.edu>"
232: "Seth Burgess"
233: "1997"
234: ""
235: SF-VALUE "Description" "\"Ellipse\""
236: SF-VALUE "Width" "20"
237: SF-VALUE "Height" "20"
238: SF-VALUE "Spacing" "25"
239: )
240:
241:
242: (define (script-fu-make-brush-elliptical-feathered description width height feathering spacing)
243: (begin
244: (let* (
245: (widthplus (+ feathering width)) ; add 3 for blurring
246: (heightplus (+ feathering height))
247: (img (car (gimp-image-new widthplus heightplus GRAY)))
248: (drawable (car (gimp-layer-new img widthplus heightplus GRAY_IMAGE "MakeBrush" 100 NORMAL)))
249:
250: ; Save old foregound and background colors
251:
252: (old-fg-color (car (gimp-palette-get-foreground)))
253: (old-bg-color (car (gimp-palette-get-background)))
254:
255: ; Construct variables...
256: (data-dir (car (gimp-gimprc-query "gimp_dir")))
257: (filename (string-append data-dir
258: "/brushes/e"
259: (number->string width)
260: "x"
261: (number->string height)
262: "f"
263: (number->string feathering)
264: ".gbr"))
265: (desc (string-append description " "
266: (number->string width)
267: "x"
268: (number->string height)
269: " f"
270: (number->string feathering)
271: )
272: )
273:
274: )
275: ; End of variables. Couple of necessary things here.
276:
277: (gimp-image-disable-undo img)
278: (gimp-image-add-layer img drawable 0)
279:
280: ; Actual code starts...
281: (gimp-palette-set-background '(0 0 0))
282: (gimp-drawable-fill drawable BG-IMAGE-FILL)
283: (gimp-palette-set-background '(255 255 255))
284: (cond ((> feathering 0) ; keep from taking out gimp with stupid entry.
285: (gimp-ellipse-select img (/ feathering 2) (/ feathering 2) width height REPLACE TRUE TRUE feathering))
286: ((<= feathering 0)
287: (gimp-ellipse-select img 0 0 width height REPLACE TRUE FALSE 0))
288: )
289: (gimp-edit-fill img drawable)
290: (file-gbr-save 1 img drawable filename "" spacing desc)
291:
292: (gimp-brushes-refresh)
293: (gimp-brushes-set-brush desc)
294:
295: ; Terminate, restoring old bg.
296:
297: (gimp-selection-none img)
298: (gimp-palette-set-foreground old-fg-color)
299: (gimp-palette-set-background old-bg-color)
300: (gimp-image-enable-undo img)
301: (gimp-image-delete img)
302: )
303: )
304: )
305:
306: ; Register with the PDB
307:
308: (script-fu-register "script-fu-make-brush-elliptical-feathered"
309: "<Toolbox>/Xtns/Script-Fu/Make Brush/Elliptical, Feathered"
310: "Create size of brush"
311: "Seth Burgess <sjburges@ou.edu>"
312: "Seth Burgess"
313: "1997"
314: ""
315: SF-VALUE "Description" "\"Ellipse\""
316: SF-VALUE "Width" "20"
317: SF-VALUE "Height" "20"
318: SF-VALUE "Feathering" "4"
319: SF-VALUE "Spacing" "25"
320: )
321: