I have submitted a lexer for inclusion into the next release of Pygments ( http://pygments.org/ ).
Pygments is used by for instance bitbucket. It will be awhile before everything is finalized so I have attached the files in question to this message if anyone wants to make some changes/improvements. Just send the changed picolisp.py file to me or directly to Georg: g.brandl-nos...@gmx.net How to is here: http://pygments.org/docs/lexerdevelopment/
(load "ext/str.l" "ext/cmd.l" "ext/hash.l" "lib/db.l")
(class +Dir +Entity)
(rel id (+Key +String))
(rel nm (+Fold +Idx +String))
(class +File +Entity)
(rel nm (+Fold +Idx +String))
(rel dir (+Ref +Link) NIL (+Dir))
(pool "/opt/picolisp/projects/indexer/db")
(de rLs ()
(let Dir (opt)
(if Dir
(split (mapcar pack (split (excmd~script 'ls NIL '-R Dir) "^J")) NIL)
(println "You need to specify a directory to parse.")
(bye) ) ) )
(de mLoop (Dtree)
(for D Dtree
(when D
(let (Nm (exstr~trim (car D) ":") Dobj (request '(+Dir) 'id Nm 'nm Nm))
(for F (cdr D)
(println F)
(request '(+File) 'nm F 'dir Dobj) ) )
(commit 'upd) ) ) )
(de getOutPut (Nm Cmd Flags)
(filter last
(mapcar
'((Lst) (mapcar pack (split Lst "/")))
(split (excmd~script Cmd NIL Flags Nm) "^J") ) ) )
(de resHash (Nm Files)
(let Hsh (new '(+Hash) NIL NIL T)
(for F Files
(if (= 1 (length F))
(add> Hsh Nm (car F))
(add> Hsh
(pack Nm "/" (exstr~trim (glue "/" (head -1 F)) "/"))
(last F) ) ) )
Hsh) )
(de getTar (Nm Flags)
(resHash Nm (getOutPut Nm 'tar Flags)))
(de getBz (Nm)
(getTar Nm '-jtf) )
(de getGz (Nm)
(getTar Nm '-ztf))
(de getZip (Nm)
(resHash Nm
(mapcar
'((Lst)
(append
(list (pack (last (exlst~split (chop (car Lst)) " "))))
(cdr Lst) ) )
(exlst~middle -2 -3 (getOutPut Nm 'unzip '-l)) ) ) )
(de getRar (Nm)
(resHash Nm
(make (for (N . El) (exlst~middle -3 -5 (getOutPut Nm 'unrar 'v))
(when (= 1 (% N 2)) (link (mapcar exstr~trim El))) ) ) ) )
(de doArchives ()
(for Ftype '((".rar" getRar) (".zip" getZip) ("tar.gz" getGz) ("tar.bz2" getBz))
(for F (byPartial (car Ftype) '+File)
(let Nm (pack (; F dir id) "/" (; F nm))
(unless (db 'id '+Dir Nm)
(request '(+Dir) 'id Nm 'nm Nm)
(println (pack "Parsing: " Nm))
(when (info Nm)
(for Lst (lst> (apply (cadr Ftype) (list Nm)))
(let Dobj (request '(+Dir) 'id (car Lst) 'nm (car Lst))
(for F (cadr Lst)
(println F)
(request '(+File) 'nm F 'dir Dobj) ) ) ) )
(commit 'upd) ) ) ) ) )
(de byPartial (Str Cls)
(solve
(quote
@Str Str
@Cls Cls
(select (@Files)
((nm @Cls @Str))
(part @Str @Files nm) ) )
@Files ) )
#(mLoop (rLs *Cdir))
#(doArchives)
#(bye)
picolisp.py
Description: Binary data
picolisptest.l
Description: Binary data
