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