code.delx.au - gnu-emacs-elpa/blob - packages/web-server/examples/013-org-export-service.el

   1 ;;; 013-org-export-service.el --- upload and export Org-mode files
   2 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   3
   4 (ws-start
   5  (lambda (request)
   6    (with-slots (process headers) request
   7      (let ((file (cdr (assoc "file" headers)))
   8            (type (cdr (assoc 'content (cdr (assoc "type" headers))))))
   9        (if (not (and file type))
  10            (progn
  11              (ws-response-header process 200 '("Content-type" . "text/html"))
  12              (process-send-string process "
  13 <html><body><form action=\"\" method=\"post\" enctype=\"multipart/form-data\">
  14 Export file: <input type=\"file\" name=\"file\"> to type
  15 <select name=\"type\">
  16 <option value=\"txt\">Text</option>
  17 <option value=\"html\">HTML</option>
  18 <option value=\"tex\">TeX</option>
  19 </select>
  20 <input type=\"submit\" value=\"submit\">.
  21 </form></body></html>"))
  22          (let* ((orig (cdr (assoc 'filename file)))
  23                 (base (file-name-nondirectory
  24                        (file-name-sans-extension orig)))
  25                 (backend (case (intern (downcase type))
  26                            (html 'html)
  27                            (tex  'latex)
  28                            (txt  'ascii)
  29                            (t (ws-error process "%S export not supported"
  30                                         type))))
  31                 (path (concat base "." type)))
  32            (let ((default-directory temporary-file-directory))
  33              (when (or (file-exists-p orig) (file-exists-p path))
  34                (ws-error process
  35                          "File already exists on the server, try a new file."))
  36              (with-temp-file orig (insert (cdr (assoc 'content file))))
  37              (save-window-excursion (find-file orig)
  38                                     ;; TODO: Steal personal data and
  39                                     ;; ideas from uploaded Org-mode
  40                                     ;; text.  Web services aren't free!
  41                                     (org-export-to-file backend path)
  42                                     (kill-buffer))
  43              (ws-send-file process path)
  44              (delete-file path)
  45              (delete-file orig)))))))
  46  9013)