;;; xslide-imenu.el --- imenu tweaks for xslide

;; $Id: xslide-imenu.el,v 1.1.1.1 2001/06/04 19:13:40 mark Exp $

;; Copyright (C) 2001, Mark Johnson <mrj@debian.org>

;; Emacs Lisp Archive Entry
;; Filename: xslide-imenu.el
;; Version: 0.2
;; Keywords: faces, xsl
;; Author: Mark Johnson <mrj@debian.org>
;; Maintainer: Mark Johnson <mrj@debian.org>
;; Description: imenu tweaks for xsl-mode
;; Created: 04 June 2001
;; URL: http://dulug.duke.edu/~mark/emacs

;; This file is not part of GNU Emacs.

;; This 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.
;;
;; This 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.

;;; Commentary:

;; This provides some mennu tweaks for xslide. In addition to templates,
;; the menu indexes parameters and variables.
;; It depends on the xslide package.

;; This isn't very elegent -- I stuck "go-to-char" statements
;; everywhere. But it works.

;; To use these menus, put this file in your load-path and add the
;; following to your startup files:

;; (add-hook
;;  'xsl-mode-hook
;;  '(lambda ()
;;     (load "xslide-imenu")
;;     (setq imenu-create-index-function 'xsl-imenu-create-index-function)
;;    (setq imenu-extract-index-name-function 'xsl-imenu-create-index-function)
;;    (imenu-add-to-menubar "XSL")))


;;; History:
;; None to speak of.

;;; Code:
(require 'xslide)

(defun xsl-imenu-create-index-function ()
  "Create an alist of elements, etc.  suitable for use with imenu."
  (interactive)
  (let ((template-alist '())
	(mode-alist '())
	(name-alist '())
	(pname-alist '())
	(vname-alist '()))
    (goto-char (point-min))

    ;; Find all param statements
    (while
	(re-search-forward
	 "^\\s-*<xsl:param\\(\\s-+\\)" nil t)
      ;; Go to the beginning of the whitespace after the element name
      (goto-char (match-beginning 1))
      ;;"name" attribute
      (if (save-excursion
	    (re-search-forward
	     "\\s-+name\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
	     (save-excursion
	       (save-match-data
		 (re-search-forward "<\\|>" nil t)))
	     t))
	  (setq pname-alist
		(cons
		 (cons (buffer-substring-no-properties
			;; Rely on the pattern that didn't match
			;; returning nil and on `or' evaluating the
			;; second form when the first returns nil.
			(or
			 (match-beginning 2)
			 (match-beginning 3))
			(or
			 (match-end 2)
			 (match-end 3)))
		       (or
			(match-beginning 2)
			(match-beginning 3)))
		 pname-alist))))
    (goto-char (point-min))
    ;; Find all variable statements
    (while
	(re-search-forward
	 "^\\s-*<xsl:variable\\(\\s-+\\)" nil t)
      ;; Go to the beginning of the whitespace after the element name
      (goto-char (match-beginning 1))
   
      ;;"name" attribute
      (if (save-excursion
	    (re-search-forward
	     "\\s-+name\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
	     (save-excursion
	       (save-match-data
		 (re-search-forward "<\\|>" nil t)))
	     t))
	  (setq vname-alist
		(cons
		 (cons (buffer-substring-no-properties
			;; Rely on the pattern that didn't match
			;; returning nil and on `or' evaluating the
			;; second form when the first returns nil.
			(or
			 (match-beginning 2)
			 (match-beginning 3))
			(or
			 (match-end 2)
			 (match-end 3)))
		       (or
			(match-beginning 2)
			(match-beginning 3)))
		 vname-alist))))
    (goto-char (point-min))
    ;; Find all templates
    (while
	(re-search-forward
	 "^\\s-*<xsl:template\\(\\s-+\\)" nil t)
      ;; Go to the beginning of the whitespace after the element name
      (goto-char (match-beginning 1))
      ;; Match on either single-quoted or double-quoted attribute value.
      ;; The expression that doesn't match will have return nil for
      ;; `match-beginning' and `match-end'.
      ;; Don't move point because the 'mode' attribute may be before
      ;; the 'match' attribute.
      (if (save-excursion
	    (re-search-forward
	     "match\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
	     (save-excursion
	       (save-match-data
		 (re-search-forward "<\\|>" nil t)))
	     t))
	  (let* ((pattern (buffer-substring-no-properties
			   ;; Rely on the pattern that didn't match
			   ;; returning nil and on `or' evaluating the
			   ;; second form when the first returns nil.
			   (or
			    (match-beginning 2)
			    (match-beginning 3))
			   (or
			    (match-end 2)
			    (match-end 3))))
		 (pattern-position (or
				    (match-beginning 2)
				    (match-beginning 3))))
	    ;; Test to see if there is a 'mode' attribute.
	    ;; Match on either single-quoted or double-quoted attribute value.
	    ;; The expression that doesn't match will have return nil for
	    ;; `match-beginning' and `match-end'.
	    (if (save-excursion
		  (re-search-forward
		   "mode\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
		   (save-excursion
		     (save-match-data
		       (re-search-forward "<\\|>" nil t)))
		   t))
		(let* ((mode-name (buffer-substring-no-properties
				   ;; Rely on the pattern that didn't match
				   ;; returning nil and on `or' evaluating the
				   ;; second form when the first returns nil.
				   (or
				    (match-beginning 2)
				    (match-beginning 3))
				   (or
				    (match-end 2)
				    (match-end 3))))
		       (mode-name-alist (assoc mode-name mode-alist)))
		  (if mode-name-alist
		      (setcdr mode-name-alist
			      (list (car (cdr mode-name-alist))
				    (cons pattern pattern-position)))
		    (setq mode-alist
			  (cons
			   (list mode-name (cons pattern pattern-position))
			   mode-alist))))
	      (setq template-alist
		    (cons (cons pattern pattern-position)
			  template-alist)))))
      ;; When there's no "match" attribute, can still have "name"
      ;; attribute
      (if (save-excursion
	    (re-search-forward
	     "\\s-+name\\s-*=\\s-*\\(\"\\([^\"]*\\)\"\\|'\\([^']*\\)'\\)"
	     (save-excursion
	       (save-match-data
		 (re-search-forward "<\\|>" nil t)))
	     t))
	  (setq name-alist
		(cons
		 (cons (buffer-substring-no-properties
			;; Rely on the pattern that didn't match
			;; returning nil and on `or' evaluating the
			;; second form when the first returns nil.
			(or
			 (match-beginning 2)
			 (match-beginning 3))
			(or
			 (match-end 2)
			 (match-end 3)))
		       (or
			(match-beginning 2)
			(match-beginning 3)))
		 name-alist))))
    (goto-char (point-min))

    ;; Imenu menu generation
    (append
     (if name-alist
	 (list (cons "<xsl:template" (xsl-sort-alist template-alist))))
     (if mode-alist
	 (list
	  (cons "<xsl:template mode="
		(xsl-sort-alist
		 (mapcar (lambda (x)
			   (cons (format "mode=\"%s\"" (car x))
				 (xsl-sort-alist (cdr x))))
			 (xsl-sort-alist mode-alist))))))
     (if vname-alist
	 (list (cons "<xsl:variable" (xsl-sort-alist vname-alist))))
     (if pname-alist
	 (list (cons "<xsl:param" (xsl-sort-alist pname-alist))))
     (xsl-sort-alist nil))))


(provide 'xslide-imenu)

;;; xslide-imenu.el ends here