Forgot your password?
typodupeerror
Programming

Journal: apache2-mode.el

Journal by ignavusinfo
;;; apache2-mode.el -- major mode for editing Apache 2 configuration files

;; Author: Kevin Montuori <montuori@gmail.com>
;; Created: 2005/11/21
;; Version: 1.0

;; Copyright (C) 2005 Kevin Montuori

;; It 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 2, or (at your option)
;; any later version.
;;
;; It 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 your copy of Emacs; see the file COPYING.  If not, write
;; to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; Parts of this code are derived from apache-mode.el by Jonathan
;; Marten; however, any errors, omissions, or bad coding is mine
;; alone.

;;; Commentary:
;;
;; Rather than attempt to keep the apache-mode lisp code up to date
;; with respect to the ever changing Apache 2.0 (and 2.2) list of
;; directives, Apache 2 mode attmpts to derive the list of Apache
;; directives from the Apache documentation website.  Once the list of
;; keywords is retrieved it is cached for faster loading and for use
;; when a network is not available.
;;
;; The w3 package is used, so if one's proxy configuration there is
;; correct there should be no issues.  Users are directed to the w3
;; documentation for further information.
;;
;; Additionally, a (now) current list of mod_perl and mod_python
;; directives is provided in this code.
;;
;; Along with font-lock, directive completion is provided, bound to
;; C-c C-a C-c by default.
;;
;; The documentation URL for individual Apache directives is available
;; and can be sent to the browser that the browse-url library uses.
;; The keybinding for this is C-c C-a C-d.  Note that mod_perl and
;; mod_python directives are not automatically discoverable on their
;; respective documentation websites so the browse documentation
;; feature does not work with these.
;;
;; A number of parameters and all the faces may be customized.  M-x
;; customize <ret> apache2 will do the needful in that regard.
;;
;; To install simply put this file in your load-path and add something
;; like this to your ~/.xemacs/init.el file:
;;
;;   (autoload 'apache2-mode "apache2-mode")
;;   (add-to-list 'auto-mode-alist '("httpd.*\\.conf$" . apache2-mode))
;;
;; a proxy server can be specified with code like this:
;;
;;   (setq url-proxy-services '(("http" . "proxy.example.com:3128")
;;                              ("no_proxy" . ".*\.example\.com"))
;;
;;
;; I'm not really an emacs-lisp programmer, so any helpful suggestions
;; or corrections are welcome.  k.

;;; code begins here.

(require 'regexp-opt)

;;; globals
(defvar apache2-mode-map nil
  "Keymap used in Apache2 mode buffers")

(defvar apache2-mode-syntax-table nil
  "Apache2 mode syntax table")

(defvar apache2-mode-hook nil
  "*List of hook functins run by `apache-mode'")

(defvar apache2-docs-list-regexp
  "<li>.*href=\"\\([^\"]+\\)\"[^>]*>\\([^<]+\\)<")

(defvar apache2-docs-assoc-list ()
  "directive lookup alist (term urlfrag)")

(defvar apache2-complete-list ()
  "completion lookup alist (term nil)")

(defvar apache2-directive-history  ())

;;; customize section.
(require 'custom)

(defgroup apache2 nil "Apache 2 Mode" :group 'languages)

(defface apache2-directive-face
    '((((class color) (background dark)) (:foreground "forest green"))
      (((class color) (background light))(:foreground "dark red"))
      (t (:bold t)))
  "The face used for Apache 2 directives"
  :group 'apache2)

(defface apache2-section-face
    '((((class color) (background dark)) (:foreground "greenyellow"))
      (((class color) (background light))(:foreground "dark green"))
      (t (:bold t)))
  "The face used for section demarcation keywords"
  :group 'apache2)

(defface apache2-section-parameter-face
    '((((class color) (background dark)) (:foreground "steel blue"))
      (((class color) (background light))(:foreground "royalblue4"))
      (t (:bold t)))
  "The face used for section demarcation parameters"
  :group 'apache2)

(defface apache2-modperl-directive-face
    '((((class color) (background dark)) (:foreground "forest green"))
      (((class color) (background light))(:foreground "dark red"))
      (t (:bold t)))
  "The face used for mod_perl directives"
  :group 'apache2)

(defface apache2-modpython-directive-face
    '((((class color) (background dark)) (:foreground "forest green"))
      (((class color) (background light))(:foreground "dark red"))
      (t (:bold t)))
  "The face used for mod_python directives"
  :group 'apache2)

(defface apache2-site-directive-face
    '((((class color) (background dark)) (:foreground "forest green"))
      (((class color) (background light))(:foreground "dark red"))
      (t (:bold t)))
  "The face used for site local directives"
  :group 'apache2)

(defcustom apache2-docs-index-url
  "http://httpd.apache.org/docs/2.0/mod/directives.html"
  "*URL where index of httpd runtime directives can be found."
  :type 'string
  :group 'apache2)

(defcustom apache2-docs-base-url
  "http://httpd.apache.org/docs/2.0/mod"
  "*Base URL for links encountered on httpd runtime directives index page."
  :type 'string
  :group 'apache2)

(defcustom apache2-custom-directives
    '("SmInitFile")
  "*List of strings to be considered valid Apache 2 directives."
  :group 'apache2)

(defcustom apache2-custom-sections
    '("Perl")
  "*List of site valid <section>...</section> identifier strings."
  :group 'apache2)

(defcustom apache2-directive-cache-file
    "~/.apache2-directive-index"
  "*Cache file for directive index."
  :type 'string
  :group 'apache2)

(defcustom apache2-directive-cache-expire
    30
  "*Days before directive cache expires"
  :type 'int
  :group 'apache2)

;;; keymap.
(if apache2-mode-map
    nil
  (setq apache2-mode-map (make-sparse-keymap))
  (define-key apache2-mode-map "\C-c\C-a\C-c" 'apache2-completion)
  (define-key apache2-mode-map "\C-c\C-a\C-d" 'apache2-lookup-directive))

;;; mode features.
(defun apache2-completion ()
  (interactive)
  (let* ((completion-alist
      (or apache2-complete-list
          (setf apache2-complete-list
            (append apache2-docs-assoc-list
                (mapcar (lambda (x) (list x ()))
                    (append apache2-modperl-keywords
                        apache2-modpython-keywords
                        apache2-custom-directives))))))
     (end (point))
     (beg (save-excursion
        (backward-word)
        (point)))
     (pattern (buffer-substring beg end))

     (completion (try-completion pattern completion-alist)))
    (cond ((null completion)
       (message "Can't find completion for \"%s\"" pattern))
      ((not (string= pattern completion))
       (delete-region beg end)
       (insert completion))
      (t
       (message "Making completion list...")
       (let ((list (all-completions pattern completion-alist)))
         (with-output-to-temp-buffer "*Completions*"
           (display-completion-list list)))
       (message "Making completion list...done")))))

(defun apache2-cache-expired-p (cache-file expiry)
  (if (not (file-exists-p cache-file))
      t  ; non-existent files are expired.
      (flet ((time-to-seconds (high low) (+ (* high (expt 2 16)) low)))
    (let* ((cur (current-time))
           (mod (nth 5 (file-attributes cache-file)))
           (diff (- (time-to-seconds (nth 0 cur) (nth 1 cur))
            (time-to-seconds (nth 0 mod) (nth 1 mod))))
           (days-since-update (/ diff (* 60 60 24))))
      (> days-since-update expiry)))))

(defun apache2-snag-index ()
  (setf apache2-docs-assoc-list ())

  ; if there's a cached file, read it.
  (if (file-readable-p apache2-directive-cache-file)
      (load-file apache2-directive-cache-file))

  ; if the cache has expired, try to update.
  (if (apache2-cache-expired-p apache2-directive-cache-file
                   apache2-directive-cache-expire)
      (apache2-lookup-index)))

(defun apache2-lookup-index ()
  (require 'w3)
  (let* ((index-buf (cdr (url-retrieve apache2-docs-index-url)))
     (term-count 0))
    (if (get-buffer index-buf)
    (progn
      (goto-char (point-min))
      (if (re-search-forward "id=\"directive-list\"" nil t)
          (progn
        (forward-line)
        (while (looking-at apache2-docs-list-regexp)
          (let ((term (match-string 2))
            (url (match-string 1)))
            (setf term-count (1+ term-count))
            (setf apache2-docs-assoc-list
              (cons (list
                 (apache2-translate-entities term) url)
                apache2-docs-assoc-list))
            (forward-line 1 index-buf)))

        ; cache the results.
        (with-temp-buffer
          (insert (concat "(setf apache2-docs-assoc-list '"
                  (prin1-to-string apache2-docs-assoc-list)
                  ")"))
          (write-file apache2-directive-cache-file))))
      (message "indexed %i terms" term-count)))))

(defun apache2-translate-entities (string)
  (replace-in-string (replace-in-string string "&gt;" ">" 1) "&lt;" "<" 1))

(defun apache2-lookup-directive (directive)
  (interactive
   (progn (if (null apache2-docs-assoc-list) (apache2-snag-index))
      (list (completing-read "Directive: " apache2-docs-assoc-list
                 nil t nil apache2-directive-history))))
  (let ((url (apache2-make-url directive)))
    (browse-url url)
    (message "looking up %s" url)))

(defun apache2-make-url (directive)
  (let ((separator (if (string= (substring apache2-docs-base-url -1) "/")
               ""
             "/")))
    (concat apache2-docs-base-url separator
        (cadr (assoc directive apache2-docs-assoc-list)))))

;;; fontification.
(defvar apache2-modperl-keywords
  (mapcar (lambda (x) (symbol-name x))
  '(PerlAddVar PerlConfigRequire PerlLoadModule PerlModule PerlOptions
    PerlPassEnv PerlPostConfigRequire PerlSetEnv PerlSetVar
    PerlSwitches PerlOpenLogsHandler PerlPostConfigHandler
    PerlChildInitHandler PerlChildExitHandler PerlRequire
    PerlPreConnectionHandler PerlProcessConnectionHandler
    PerlInputFilterHandler PerlOutputFilterHandler
    PerlSetInputFilter PerlSetOutputFilter PerlHandler
    PerlPostReadRequestHandler PerlTransHandler PerlSendHeader
    PerlMapToStorageHandler PerlInitHandler PerlHeaderParserHandler
    PerlAccessHandler PerlAuthenHandler PerlAuthzHandler
    PerlTypeHandler PerlFixupHandler PerlResponseHandler
    PerlLogHandler PerlCleanupHandler PerlInterpStart
    PerlInterpMax PerlInterpMinSpare PerlInterpMaxSpare
    PerlInterpMaxRequests PerlInterpScope PerlTrace)))

(defvar apache2-modpython-keywords
  (mapcar (lambda (x) (symbol-name x))
  '(PythonPath PythonPostReadRequestHandler PerlTransHandler
    PythonHeaderParserHandler PythonInitHandler PythonAccessHandler
    PythonAuthenHandler PythonAuthzHandler PythonTypeHandler
    PythonFixupHandler PythonHandler PythonLogHandler
    PythonCleanupHandler PythonInputFilter PythonOutputFilter
    PythonConnectionHandler PythonEnablePdb PythonDebug
    PythonImport PythonInterpPerDirecory PythonInterpPerDirective
    PythonInterpreter PythonHandlerModule PythonAutoReload
    PythonOptimize PythonOption)))

(defun apache2-font-lock-pattern (keyword-list)
  (concat "^\\s-*\\(" (regexp-opt keyword-list) "\\)\\W"))

(defun apache2-grok-font-words ()
  (let ((locations apache2-custom-sections)
    (keywords ()))
    (if (null apache2-docs-assoc-list) (apache2-snag-index))
    (mapc (lambda (a)
        (if (string= "<" (substring (car a) 0 1))
        (let ((loc (replace-in-string (car a) "<\\|>" "")))
          (setf locations (append (list loc) locations)))
          (setf keywords (append (list (car a)) keywords))))
      apache2-docs-assoc-list)

    (setf apache2-font-lock-keywords
      (list

       (list (apache2-font-lock-pattern apache2-modperl-keywords)
         1 'apache2-modperl-directive-face)

       (list (apache2-font-lock-pattern apache2-modpython-keywords)
         1 'apache2-modpython-directive-face)

       (list "^\\s-*#.*$" 0 'font-lock-comment-face t)))

    (if (not (null apache2-custom-directives))
    (setf apache2-font-lock-keywords
          (append apache2-font-lock-keywords
              (list
               (list
            (apache2-font-lock-pattern apache2-custom-directives)
            1 'apache2-site-directive-face)))))

    (if (not (or (null keywords) (null locations)))
    (setf apache2-font-lock-keywords
          (append
           apache2-font-lock-keywords
           (list

        (list "\\(<Perl>[^#]+</Perl>\\)"
              1 'apache2-perl-section-face)

        (list (concat "^\\s-*</?\\(" (regexp-opt locations)
                  "\\)\\(>\\|\\s-\\)")
              1 'apache2-section-face)

        (list (concat "^\\s-*<\\(" (regexp-opt locations)
                  "\\)\\s-*\\([^>]+\\)")
              2 'apache2-section-parameter-face)

        (list (apache2-font-lock-pattern keywords)
              1 'apache2-directive-face)))))

    (put 'apache2-mode 'font-lock-defaults '(apache2-font-lock-keywords
                         nil t ((?_ . "w")
                            (?- . "w"))))))

;; the syntax table is from apache-mode.el
(if apache2-mode-syntax-table
    nil
  (setq apache2-mode-syntax-table (copy-syntax-table nil))
  (modify-syntax-entry ?_   "_"     apache2-mode-syntax-table)
  (modify-syntax-entry ?-   "_"     apache2-mode-syntax-table)
  (modify-syntax-entry ?\(  "(\)"   apache2-mode-syntax-table)
  (modify-syntax-entry ?\)  ")\("   apache2-mode-syntax-table)
  (modify-syntax-entry ?\<  "(\>"   apache2-mode-syntax-table)
  (modify-syntax-entry ?\>  ")\<"   apache2-mode-syntax-table)
  (modify-syntax-entry ?\"   "\""   apache2-mode-syntax-table))
;;;

(defun apache2-mode ()
  "Major mode for editing Apache version 2.0 configuration files.

\\{apache2-mode-map}"

  (interactive)
  (kill-all-local-variables)
  (use-local-map apache2-mode-map)
  (set-syntax-table apache2-mode-syntax-table)

  ;; this stanza from apache-mode.el
  (make-local-variable 'comment-start)
  (setq comment-start "# ")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "#\\W*")
  (make-local-variable 'comment-column)
  (setq comment-column 48)
  ;;;

  (setq mode-name "Apache 2")
  (setq major-mode 'apache2-mode)
  (run-hooks 'apache2-mode-hook)
  (apache2-grok-font-words))

(provide 'apache2-mode)

;; apache2-mode.el ends here

COMPASS [for the CDC-6000 series] is the sort of assembler one expects from a corporation whose president codes in octal. -- J.N. Gray

Working...