external/smarkup/src/smarkup-asdf.cl

   1 ;;; -*- Mode: lisp; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-;;;
   2 ;;;
   3 ;;; file: smarkup-asdf.cl
   4 ;;; author: cyrus harmon
   5 ;;;
   6
   7 ;;;
   8 ;;; smarkup ASDF classes and methods for various component types
   9 ;;; and operations on them
  10
  11 (in-package :smarkup)
  12
  13 (defclass filtered-object (ch-asdf:object-from-variable)
  14   ((filters :accessor object-filters :initarg :filters)))
  15
  16 (defmethod perform ((op compile-op) (c filtered-object))
  17   (call-next-method)
  18   (setf (symbol-value (ch-asdf::object-symbol c))
  19         (apply-filters
  20          (symbol-value (ch-asdf::object-symbol c))
  21          (object-filters c))))
  22
  23 (defmethod component-relative-pathname ((component filtered-object)))
  24
  25 (defmethod component-pathname ((component filtered-object)))
  26
  27 (defparameter *pdflatex-program* "pdflatex")
  28 (defparameter *pdflatex-program-path*
  29   (let ((found (sb-ext:find-executable-in-search-path
  30                 *pdflatex-program*)))
  31     (unless found
  32       (setf found
  33             #+darwin "/opt/local/bin/pdflatex"
  34             #-darwin "/usr/local/bin/pdflatex"))
  35     found))
  36
  37 (defclass object-latex-file (ch-asdf:object-from-variable generated-file) ())
  38
  39 (defmethod perform ((op ch-asdf::generate-op) (c object-latex-file))
  40   (call-next-method)
  41   (render-as :latex
  42              (symbol-value (ch-asdf::object-symbol c))
  43              (component-pathname c)))
  44
  45 (defmethod perform ((operation compile-op) (c object-latex-file))
  46   (with-component-directory (c)
  47     (let ((unix-path (ch-util::unix-name (component-pathname c))))
  48       (ch-util::run-program *pdflatex-program-path*
  49                             (list unix-path))
  50       ;; we have to do this twice to get the references right!
  51       ;; maybe 3x?
  52       (ch-util::run-program *pdflatex-program-path*
  53                             (list unix-path)))))
  54
  55 (defmethod operation-done-p ((o ch-asdf::generate-op) (c object-latex-file))
  56   (declare (optimize (debug 3)))
  57   (let ((on-disk-time
  58          (file-write-date (component-pathname c)))
  59         (obj (asdf::find-component
  60               (asdf::component-parent c)
  61               (asdf::coerce-name (ch-asdf::object-input-object c)))))
  62
  63     (let ((obj-date (asdf::component-property obj 'ch-asdf::last-loaded)))
  64       (and on-disk-time
  65            obj-date
  66            (>= on-disk-time obj-date)))))
  67
  68 (defclass object-xhtml-file (ch-asdf:object-from-variable source-file) ())
  69
  70 (defmethod perform ((op compile-op) (c object-xhtml-file))
  71   (call-next-method)
  72   (let ((sexp (symbol-value (ch-asdf::object-symbol c)))
  73         (file (component-pathname c)))
  74     (render-as :xhtml sexp file)))
  75
  76 (defmethod perform ((op load-op) (c object-xhtml-file))
  77   (call-next-method)
  78   (ch-util::firefox-open (ch-util::unix-name (component-pathname c))))
  79
  80 (defclass object-cl-pdf-file (ch-asdf:object-from-variable pdf-file) ())
  81
  82 (defmethod perform ((op compile-op) (c object-cl-pdf-file))
  83   (call-next-method)
  84   (let ((sexp (symbol-value (ch-asdf::object-symbol c)))
  85         (file (component-pathname c)))
  86     (render-as :cl-pdf sexp file)))
  87
  88 (defmethod perform ((op load-op) (c object-cl-pdf-file))
  89   (call-next-method)
  90   (ch-util::app-open (unix-name (component-pathname c))))
  91