code.delx.au - gnu-emacs-elpa/blob - packages/web-server/examples/007-org-mode-file-server.el

   1 ;;; org-mode-file-server.el --- serve on-demand exported Org-mode files
   2 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   3
   4 (lexical-let ((docroot "/tmp/"))
   5   (ws-start
   6    (lambda (request)
   7      (with-slots (process headers) request
   8        (let ((path (ws-in-directory-p ; check if path is in docroot
   9                     docroot (substring (cdr (assoc :GET headers)) 1))))
  10          (unless path (ws-send-404 process)) ; send 404 if not in docroot
  11          (if (file-directory-p path)
  12              (progn ;; send directory listing, convert org files to html/tex/txt
  13                (ws-response-header proc 200 (cons "Content-type" "text/html"))
  14                (process-send-string proc
  15                  (concat "<ul>"
  16                          (mapconcat
  17                           (lambda (f)
  18                             (let* ((full (expand-file-name f path))
  19                                    (end (if (file-directory-p full) "/" ""))
  20                                    (url (url-encode-url (concat f end))))
  21                               (format "<li><a href=%s>%s</li>" url f)))
  22                           (apply #'append
  23                                  (mapcar
  24                                   (lambda (f)
  25                                     (list (concat f ".txt")
  26                                           (concat f ".tex")
  27                                           (concat f ".html")))
  28                                   (mapcar #'file-name-sans-extension
  29                                           (directory-files path nil
  30                                                            "^[^\.].*org$"))))
  31                           "\n") "</ul>")))
  32            ;; Export the file as requested and return the result
  33            (let* ((base (file-name-sans-extension path))
  34                   (type (case (intern (downcase (file-name-extension path)))
  35                           (html 'html)
  36                           (tex  'latex)
  37                           (txt  'ascii)
  38                           (t (ws-error process "%S export not supported"
  39                                        (file-name-extension path)))))
  40                   (orig (concat base ".org")))
  41              (unless (file-exists-p orig) (ws-send-404 process))
  42              (save-window-excursion (find-file orig)
  43                                     (org-export-to-file type path))
  44              (ws-send-file process path))))))
  45    9007))