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
         '((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
              (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)
         @Str Str
         @Cls Cls
       (select (@Files)
          ((nm @Cls @Str))
          (part @Str @Files nm) ) )
    @Files ) )

#(mLoop (rLs *Cdir))

Attachment: picolisp.py
Description: Binary data

Attachment: picolisptest.l
Description: Binary data

Reply via email to