code.delx.au - gnu-emacs-elpa/blob - packages/web-server/examples/015-auto-mode-server.el

   1 ;;; auto-mode-server.el --- files with fontification from the `auto-mode-alist'
   2 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   3
   4 (require 'htmlize)
   5
   6 (lexical-let ((docroot default-directory))
   7   (ws-start
   8    (lambda (request)
   9      (with-slots (process headers) request
  10        (let ((path (ws-in-directory-p
  11                     docroot (substring (cdr (assoc :GET headers)) 1))))
  12          (if path
  13              (if (file-directory-p path)
  14                  (ws-send-directory-list process
  15                    (expand-file-name path docroot) "^[^\.]")
  16                ;; send htmlize version of file
  17                (let ((mode (or (cdr (cl-assoc-if (lambda (re) (string-match re path))
  18                                                  auto-mode-alist))
  19                                'fundamental-mode)))
  20                  (ws-response-header process 200
  21                    '("Content-type" . "text/html; charset=utf-8"))
  22                  (process-send-string process
  23                    (with-temp-buffer
  24                      (insert-file-contents-literally path)
  25                      (funcall mode)
  26                      (let ((html (htmlize-buffer)))
  27                        (prog1 (with-current-buffer html (buffer-string))
  28                          (kill-buffer html)))))))
  29            (ws-send-404 process)))))
  30    9015))