commit 0a47e0d52e4ea6f9ce95dde50f6d8dcee07ae429 parent c9c9e71329376dc1f7f647751e03bf24e628b148 Author: Tomas Hlavaty <tom@logand.com> Date: Fri, 29 Apr 2011 01:21:35 +0200 compute xref url Diffstat:
| M | swank-picolisp.l | | | 50 | ++++++++++++++++++++++++++++++++++++++++++++++++-- |
1 file changed, 48 insertions(+), 2 deletions(-)
diff --git a/swank-picolisp.l b/swank-picolisp.l @@ -182,9 +182,55 @@ (de swank:swank-expand-1 (Form) Form ) +(de *Swank:xref . NIL) + +(de %swank:ensure-xref () + (setq *Swank:xref ## TODO really compute + (mapcar pack + '( ## Symbol Functions + new sym str char name sp? pat? fun? all intern extern ==== qsym loc box? str? ext? touch zap length size format chop pack glue pad align center text wrap pre? sub? low? upp? lowc uppc fold val getd set setq def de dm recur undef redef daemon patch xchg on off onOff zero one default expr subr let let? use accu push push1 pop cut del queue fifo idx lup cache locale dirname + ## Property Access + put get prop ; =: : :: putl getl wipe meta + ## Predicates + atom pair circ? lst? num? sym? flg? sp? pat? fun? box? str? ext? bool not == n== = <> =0 =T n0 nT < <= > >= match + ## Arithmetics + + - * / % */ ** inc dec >> lt0 le0 ge0 gt0 abs bit? & | x| sqrt seed rand max min length size accu format pad money round bin oct hex hax fmt64 + ## List Processing + car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr cadddr cddddr nth con cons conc circ rot list need range full make made chain link yoke copy mix append delete delq replace insert remove place strip split reverse flip trim clip head tail stem fin last member memq mmeq sect diff index offset prior assoc asoq rank sort uniq group length size val set xchg push push1 pop cut queue fifo idx balance get fill apply + ## Control Flow + load args next arg rest pass quote as lit eval run macro curry def de dm recur recurse undef box new type isa method meth send try super extra with bind job let let? use and or nand nor xor bool not nil t prog prog1 prog2 if if2 ifn when unless cond nond case state while until loop do at for catch throw finally co yield ! e $ sys call tick ipid opid kill quit task fork pipe later timeout abort bye + ## Mapping + apply pass maps map mapc maplist mapcar mapcon mapcan filter extract seek find pick cnt sum maxi mini fish by + ## Input/Output + path in out err ctl ipid opid pipe any sym str load hear tell key poll peek char skip eol eof from till line format scl read print println printsp prin prinl msg space beep tab flush rewind rd pr wr wait sync echo info file dir lines open close port listen accept host connect udp script once rc acquire release pretty pp show view here prEval mail + ## Object Orientation + *Class class dm rel var var: new type isa method meth send try object extend super extra with This can dep + ## Database + pool journal id seq lieu lock commit rollback mark free dbck dbs dbs+ db: tree db aux collect genKey useKey +relation +Any +Bag +Bool +Number +Date +Time +Symbol +String +Link +Joint +Blob +Hook +index +Key +Ref +Ref2 +Idx +Sn +Fold +Aux +Dep +List +Need +Mis +Alt blob dbSync new! set! put! inc! blob! upd rel request obj fmt64 root fetch store count leaf minKey maxKey init step scan iter prune zapTree chkTree db/3 db/4 db/5 val/3 lst/3 map/3 isa/2 same/3 bool/3 range/3 head/3 fold/3 part/3 tolr/3 select/3 remote/2 + ## Pilog + prove -> unify be repeat asserta assertz retract rules goal fail pilog solve query ? repeat/0 fail/0 true/0 not/1 call/1 or/2 nil/1 equal/2 different/2 append/3 member/2 delete/3 permute/2 uniq/2 asserta/1 assertz/1 retract/1 clause/2 show/1 db/3 db/4 db/5 val/3 lst/3 map/3 isa/2 same/3 bool/3 range/3 head/3 fold/3 part/3 tolr/3 select/3 remote/2 + ## Debugging + pretty pp show loc *Dbg doc more depth what who can dep debug d unbug u vi ld trace untrace traceAll proc hd bench edit lint lintAll select update + ## System Functions + cmd argv opt version gc raw alarm protect heap stack adr env up date time usec stamp dat$ $dat datSym datStr strDat expDat day week ultimo tim$ $tim telStr expTel locale allowed allow pwd cd chdir ctty info dir dirname errno native call tick kill quit task fork forked pipe timeout mail assert test bye + ## Globals + NIL *OS *DB T *Solo *PPid *Pid @ @@ @@@ This *Dbg *Zap *Scl *Class *Dbs *Run *Hup *Sig1 *Sig2 ^ *Err *Msg *Uni *Led *Tsm *Adr *Allow *Fork *Bye ) ) ) ) + (de swank:describe-symbol (Nm) - (pack "TODO swank:describe-symbol " Nm) ) + (%swank:ensure-xref) + ## TODO display actual content of the link + (pack "TODO swank:describe-symbol " Nm " " + (when (member Nm *Swank:xref) + (pack "file://" (path "@") "doc/ref" + (let X (chop Nm) + (cond + ((= "*" (car X)) + (uppc (cadr X)) ) + ((member (lowc (car X)) + (chop "abcdefghijklmnopqrstuvwxyz") ) + (uppc (car X)) ) + (T "_") ) ) + ".html#" Nm ) ) ) ) (de swank:init-inspector (Form) ) -