diff options
Diffstat (limited to 'emacs.d/elisp/muse/muse-http.el')
| -rw-r--r-- | emacs.d/elisp/muse/muse-http.el | 239 |
1 files changed, 0 insertions, 239 deletions
diff --git a/emacs.d/elisp/muse/muse-http.el b/emacs.d/elisp/muse/muse-http.el deleted file mode 100644 index 40bd1cb..0000000 --- a/emacs.d/elisp/muse/muse-http.el +++ /dev/null @@ -1,239 +0,0 @@ -;;; muse-http.el --- publish HTML files over HTTP - -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. - -;; This file is part of Emacs Muse. It is not part of GNU Emacs. - -;; Emacs Muse is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; Emacs Muse is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with Emacs Muse; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Contributors: - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Publishing HTML over HTTP (using httpd.el) -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'muse-html) -(require 'muse-project) -(require 'httpd) -(require 'cgi) - -(defgroup muse-http nil - "Options controlling the behavior of Emacs Muse over HTTP." - :group 'press) - -(defcustom muse-http-maintainer (concat "webmaster@" (system-name)) - "The maintainer address to use for the HTTP 'From' field." - :type 'string - :group 'muse-http) - -(defcustom muse-http-publishing-style "html" - "The style to use when publishing projects over http." - :type 'string - :group 'muse-http) - -(defcustom muse-http-max-cache-size 64 - "The number of pages to cache when serving over HTTP. -This only applies if set while running the persisted invocation -server. See main documentation for the `muse-http' -customization group." - :type 'integer - :group 'muse-http) - -(defvar muse-buffer-mtime nil) -(make-variable-buffer-local 'muse-buffer-mtime) - -(defun muse-sort-buffers (l r) - (let ((l-mtime (with-current-buffer l muse-buffer-mtime)) - (r-mtime (with-current-buffer r muse-buffer-mtime))) - (cond - ((and (null l-mtime) (null r-mtime)) l) - ((null l-mtime) r) - ((null r-mtime) l) - (t (muse-time-less-p r-mtime l-mtime))))) - -(defun muse-winnow-list (entries &optional predicate) - "Return only those ENTRIES for which PREDICATE returns non-nil." - (let ((flist (list t))) - (let ((entry entries)) - (while entry - (if (funcall predicate (car entry)) - (nconc flist (list (car entry)))) - (setq entry (cdr entry)))) - (cdr flist))) - -(defun muse-http-prune-cache () - "If the page cache has become too large, prune it." - (let* ((buflist - (sort (muse-winnow-list (buffer-list) - (function - (lambda (buf) - (with-current-buffer buf - muse-buffer-mtime)))) - 'muse-sort-buffers)) - (len (length buflist))) - (while (> len muse-http-max-cache-size) - (kill-buffer (car buflist)) - (setq len (1- len))))) - -(defvar muse-http-serving-p nil) - -(defun muse-http-send-buffer (&optional modified code msg) - "Markup and send the contents of the current buffer via HTTP." - (httpd-send (or code 200) (or msg "OK") - "Server: muse.el/" muse-version httpd-endl - "Connection: close" httpd-endl - "MIME-Version: 1.0" httpd-endl - "Date: " (format-time-string "%a, %e %b %Y %T %Z") - httpd-endl - "From: " muse-http-maintainer httpd-endl) - (when modified - (httpd-send-data "Last-Modified: " - (format-time-string "%a, %e %b %Y %T %Z" modified) - httpd-endl)) - (httpd-send-data "Content-Type: text/html; charset=iso-8859-1" httpd-endl - "Content-Length: " (number-to-string (1- (point-max))) - httpd-endl httpd-endl - (buffer-string)) - (httpd-send-eof)) - -(defun muse-http-reject (title msg &optional annotation) - (muse-with-temp-buffer - (insert msg ".\n") - (if annotation - (insert annotation "\n")) - (muse-publish-markup-buffer title muse-http-publishing-style) - (muse-http-send-buffer nil 404 msg))) - -(defun muse-http-prepare-url (target explicit) - (save-match-data - (unless (or (not explicit) - (string-match muse-url-regexp target) - (string-match muse-image-regexp target) - (string-match muse-file-regexp target)) - (setq target (concat "page?" target - "&project=" muse-http-serving-p)))) - (muse-publish-read-only target)) - -(defun muse-http-render-page (name) - "Render the Muse page identified by NAME. -When serving from a dedicated Emacs process (see the httpd-serve -script), a maximum of `muse-http-max-cache-size' pages will be -cached in memory to speed up serving time." - (let ((file (muse-project-page-file name muse-http-serving-p)) - (muse-publish-url-transforms - (cons 'muse-http-prepare-url muse-publish-url-transforms)) - (inhibit-read-only t)) - (when file - (with-current-buffer (get-buffer-create file) - (let ((modified-time (nth 5 (file-attributes file))) - (muse-publishing-current-file file) - muse-publishing-current-style) - (when (or (null muse-buffer-mtime) - (muse-time-less-p muse-buffer-mtime modified-time)) - (erase-buffer) - (setq muse-buffer-mtime modified-time)) - (goto-char (point-max)) - (when (bobp) - (muse-insert-file-contents file t) - (let ((styles (cddr (muse-project muse-http-serving-p))) - style) - (while (and styles (null style)) - (let ((include-regexp - (muse-style-element :include (car styles))) - (exclude-regexp - (muse-style-element :exclude (car styles)))) - (when (and (or (and (null include-regexp) - (null exclude-regexp)) - (if include-regexp - (string-match include-regexp file) - (not (string-match exclude-regexp file)))) - (not (muse-project-private-p file))) - (setq style (car styles)) - (while (muse-style-element :base style) - (setq style - (muse-style (muse-style-element :base style)))) - (if (string= (car style) muse-http-publishing-style) - (setq style (car styles)) - (setq style nil)))) - (setq styles (cdr styles))) - (muse-publish-markup-buffer - name (or style muse-http-publishing-style)))) - (set-buffer-modified-p nil) - (muse-http-prune-cache) - (current-buffer)))))) - -(defun muse-http-transmit-page (name) - "Render the Muse page identified by NAME. -When serving from a dedicated Emacs process (see the httpd-serve -script), a maximum of `muse-http-max-cache-size' pages will be -cached in memory to speed up serving time." - (let ((inhibit-read-only t) - (buffer (muse-http-render-page name))) - (if buffer - (with-current-buffer buffer - (muse-http-send-buffer muse-buffer-mtime))))) - -(defvar httpd-vars nil) - -(defsubst httpd-var (var) - "Return value of VAR as a URL variable. If VAR doesn't exist, nil." - (cdr (assoc var httpd-vars))) - -(defsubst httpd-var-p (var) - "Return non-nil if VAR was passed as a URL variable." - (not (null (assoc var httpd-vars)))) - -(defun muse-http-serve (page &optional content) - "Serve the given PAGE from this press server." - ;; index.html is really a reference to the project home page - (if (and muse-project-alist - (string-match "\\`index.html?\\'" page)) - (setq page (concat "page?" - (muse-get-keyword :default - (cadr (car muse-project-alist)))))) - ;; handle the actual request - (let ((vc-follow-symlinks t) - (muse-publish-report-threshhold nil) - muse-http-serving-p - httpd-vars) - (save-excursion - ;; process any CGI variables, if cgi.el is available - (if (string-match "\\`\\([^&]+\\)&" page) - (setq httpd-vars (cgi-decode (substring page (match-end 0))) - page (match-string 1 page))) - (unless (setq muse-http-serving-p (httpd-var "project")) - (let ((project (car muse-project-alist))) - (setq muse-http-serving-p (car project)) - (setq httpd-vars (cons (cons "project" (car project)) - httpd-vars)))) - (if (and muse-http-serving-p - (string-match "\\`page\\?\\(.+\\)" page)) - (muse-http-transmit-page (match-string 1 page)))))) - -(if (featurep 'httpd) - (httpd-add-handler "\\`\\(index\\.html?\\|page\\(\\?\\|\\'\\)\\)" - 'muse-http-serve)) - -(provide 'muse-http) - -;;; muse-http.el ends here |