enlivend (enlivend) wrote,

Ink on the page

I get sufficiently distracted by the sight of package prefixes that I tend to make rather heavy use of use-package — enough to call attention to myself in some circles. Reading Cyrus Harmon's piece on Cheminformatics this morning got me wondering whether there was a local alternative to package use...

CL-USER 46 > (defmacro using ((&rest packages) &body body)
               (let ((packages (mapcar 'find-package packages)))
                 (labels ((symbol-try (symbol package)
                            (multiple-value-bind (symbol status)
                                (find-symbol (symbol-name symbol) package)
                              (when (eq status :external)
                                ;; being lazy here about foo:nil
                          (symbol (symbol)
                            (let ((possibles (remove nil (mapcar (lambda (package) (symbol-try symbol package)) packages))))
                              (cond ((cdr possibles)
                                     (error "Symbol ~a exported from more than one package: ~{~a~^, ~}"
                                            symbol (mapcar 'package-name possibles))) 
                                     (car possibles)))))
                          (form (form)
                            (loop for thing in form collect
                                  (cond ((symbolp thing)
                                         (or (symbol thing)
                                        ((consp thing)
                                         (form thing))
                                        (t thing)))))
                   (let ((expansion (form body)))
                     (if (cdr expansion)
                         `(progn ,@expansion)
                       (car expansion))))))

CL-USER 47 > (pprint
               '(using (java)
                  (with-open-file (out-stream pathname :direction :output  
                                              :if-exists :supersede  
                                              :element-type :default)  
                        ((r (jnew |AtomContainerRenderer|  
                                   (jnew |BasicAtomGenerator|)  
                                   (jnew |BasicBondGenerator|)  
                                   (jnew |BasicSceneGenerator|))  
                                  (jnew |AWTFontManager|)))  
                         (vg (jnew |SVGGraphics2D|  
                                   (jcall "getWrappedOutputStream" out-stream)  
                                   (jnew |Dimension| 320 320)))  
                         (adv (jnew |AWTDrawVisitor| vg)))  
                      (jcall "startExport" vg)  
                      (jcall "generateCoordinates"  
                             (jnew |StructureDiagramGenerator| mol))  
                      (jcall "setup" r mol (jnew |Rectangle| 0 0 100 100))  
                      (jcall "paint" r mol adv  
                             (jnew (jconstructor |Rectangle2D$Double| 4)  
                                   10 10 300 300)  
                      (jcall "endExport" vg))))

  (LET* ((R
           (JLIST (JAVA:JNEW |BasicAtomGenerator|) (JAVA:JNEW |BasicBondGenerator|) (JAVA:JNEW |BasicSceneGenerator|))
           (JAVA:JNEW |AWTFontManager|)))
         (VG (JAVA:JNEW |SVGGraphics2D| (JAVA:JCALL "getWrappedOutputStream" OUT-STREAM) (JAVA:JNEW |Dimension| 320 320)))
         (ADV (JAVA:JNEW |AWTDrawVisitor| VG)))
    (JAVA:JCALL "startExport" VG)
    (JAVA:JCALL "generateCoordinates" (JAVA:JNEW |StructureDiagramGenerator| MOL))
    (JAVA:JCALL "setup" R MOL (JAVA:JNEW |Rectangle| 0 0 100 100))
    (JAVA:JCALL "paint" R MOL ADV (JAVA:JNEW (JAVA:JCONSTRUCTOR |Rectangle2D$Double| 4) 10 10 300 300) JAVA:+TRUE+)
    (JAVA:JCALL "endExport" VG)))

CL-USER 48 > 
Tags: lisp
  • Post a new comment


    Anonymous comments are disabled in this journal

    default userpic

    Your reply will be screened