;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.presentation) ;;;;;; ;;; exportable/component (def (component e) exportable/component () ()) (def layered-method make-export-commands ((component exportable/component) class prototype value) (optional-list (make-export-command :txt component class prototype value) (make-export-command :csv component class prototype value) (make-export-command :pdf component class prototype value) (make-export-command :ods component class prototype value) (make-export-command :odt component class prototype value) (make-export-command :sh component class prototype value))) (def (layered-function e) export-file-name (format component value) (:method :around (format component value) (awhen (call-next-layered-method) (string+ it "." (string-downcase format)))) (:method (format component value) (lookup-first-matching-resource* (:default "unnamed") ("export.default-filename" (string-downcase format)) "export.default-filename"))) (def macro with-output-to-export-stream ((stream-name &key external-format content-type file-name) &body body) (with-unique-names (response-body) (once-only (content-type) `(bind ((,response-body (with-output-to-sequence (,stream-name :external-format ,external-format :initial-buffer-size 256) ,@body))) (make-byte-vector-response* ,response-body :headers (nconc (when ,content-type (list (cons +header/content-type+ ,content-type))) (list (cons +header/content-disposition+ (make-content-disposition-header-value :file-name ,file-name))))))))) ;;;;;; ;;; Text format (def layered-method export-text ((self exportable/component)) (with-output-to-export-stream (*text-stream* :content-type +text-mime-type+ :external-format (guess-encoding-for-http-response)) (with-active-layers (passive-layer) (render-text self)))) (def layered-function write-text-line-begin () (:method () (values))) (def layered-function write-text-line-separator () (:method () (terpri *text-stream*))) ;;;;;; ;;; CSV format (def layered-method export-csv ((self exportable/component)) (with-output-to-export-stream (*csv-stream* :content-type +csv-mime-type+ :external-format (guess-encoding-for-http-response)) (with-active-layers (passive-layer) (render-csv self)))) ;;;;;; ;;; ODT format (def with-macro* with-xml-document-header/open-document-format (stream &key (encoding (guess-encoding-for-http-response)) mime-type) (emit-xml-prologue :encoding encoding :stream stream :version "1.0") > > > > > > >> > >) (def layered-method export-odt ((self exportable/component)) (bind ((encoding (guess-encoding-for-http-response))) (with-output-to-export-stream (*xml-stream* :content-type +odt-mime-type+ :external-format encoding) (with-xml-document-header/open-document-format (*xml-stream* :encoding encoding :mime-type +odt-mime-type+) )))) ;;;;;; ;;; ODS format (def layered-method export-ods ((self exportable/component)) (bind ((encoding (guess-encoding-for-http-response))) (with-output-to-export-stream (*xml-stream* :content-type +ods-mime-type+ :external-format encoding) (with-xml-document-header/open-document-format (*xml-stream* :encoding encoding :mime-type +ods-mime-type+) >)))) ;;;;;; ;;; SH format (def (layered-method e) export-sh ((self component)) (with-output-to-export-stream (*text-stream* :content-type +text-mime-type+ :external-format (guess-encoding-for-http-response)) (with-active-layers (passive-layer) (render-sh self))))