ilisp / ilisp-imenu.el

;;; -*- Mode: Emacs-Lisp -*-

;;; ilisp-out.el --
;;; This file is part of ILISP.
;;; Please refer to the file COPYING for copyrights and licensing
;;; information.
;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
;;; of present and past contributors.
;;; $Id$

(require 'imenu)

;;; modified for a better display of function+arglist! 
;;; let tokens contain spaces and test with string-equal.

(defun imenu--completion-buffer (index-alist &optional prompt)
  "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.

Returns t for rescan and otherwise a position number."
  ;; Create a list for this buffer only when needed.
  (let ((name (thing-at-point 'symbol))
    (cond (prompt)
	  ((and name (imenu--in-alist name index-alist))
	   (setq prompt (format "Index item (default %s): " name)))
	  (t (setq prompt "Index item: ")))
    (if (eq imenu-always-use-completion-buffer-p 'never)
  	(setq name (completing-read prompt
 				    nil t nil 'imenu--history-list name))
	;; Display the completion buffer
	(with-output-to-temp-buffer "*Completions*"
	   (all-completions "" index-alist )))
	(let ((minibuffer-setup-hook
		(lambda ()
		  (let ((buffer (current-buffer)))
		      (set-buffer "*Completions*")
		      (setq completion-reference-buffer buffer)))))))
	  ;; Make a completion question
	  (setq name (completing-read prompt
                                      t nil 'imenu--history-list name)))))
    (cond ((not (stringp name))
	  ((string= name (car imenu--rescan-item))
	   (setq choice (assoc name index-alist))
	   (if (imenu--subalist-p choice)
	       (imenu--completion-buffer (cdr choice) prompt)

;;; Patch for ilisp-imenu

;; Intent is to allow users to customize what forms can
;; define types, variables, etc.  At the moment, this is
;; hardcoded in ilisp-imenu-create-lisp-index.
;; This file replaces and enhances that. function.

(defvar ilisp-*defining-form-regexp* "^(def"
  "Regular expression indicating that the form will define something.")

(defvar ilisp-*type-defining-forms*
  '(deftype defstruct defclass define-condition)
  "Symbols that announce the definition of a new lisp type.
Don't change this variable -- rather
customize ilisp-*user-type-defining-forms*")

(defvar ilisp-*user-type-defining-forms* nil
  "*List of user defined symbols which define new lisp types.")

(defvar ilisp-*variable-defining-forms*
  '(defvar defconstant defparameter)
  "Symbols that announce the definition of a lisp variable.
Don't change this variable -- rather customize

(defvar ilisp-*user-variable-defining-forms* nil
  "*List of user defined symbols which define new lisp variables.")
(defvar ilisp-*function-defining-forms* '(defun defmethod defmacro defgeneric)
  "Symbols that announce the definition of a new new lisp function.
Don't change this variable -- rather customize

(defvar ilisp-*user-function-defining-forms* nil
  "*List of user defined symbols which define new lisp functions.")

(defun ilisp-build-optimal-regexp (key)
  "Build an optimal regular expression to match tokens used to define
things of class KEY, which can be `:types' or `:variables'."
  (regexp-opt (mapcar #'symbol-name
		       (ecase key
			 (:types (append ilisp-*type-defining-forms*
			 (:variables (append ilisp-*variable-defining-forms*
			 (:functions (append ilisp-*function-defining-forms*

(defun ilisp-imenu-create-lisp-index ()
  ;; `imenu-create-index-function' is set to this.
  ;; generates a nested index of definitions.
  (let ((index-fun-alist '())
	(index-var-alist '())
        (index-const-alist '())
	(index-type-alist '())
	(index-unknown-alist '())
	(prev-pos nil)
    (goto-char (point-max))
    (imenu-progress-message prev-pos 0)

    ;; This will be a bit slower at runtime, but hey, we don't
    ;; rebuild the index very often, and at least this way,
    ;; we'll get it right.  [ap 13/5/2001]
    (let ((type-defining-form-regexp (ilisp-build-optimal-regexp :types))
	  (variable-defining-form-regexp (ilisp-build-optimal-regexp :variables))
	  (function-defining-form-regexp (ilisp-build-optimal-regexp :functions)))
      ;; Search for the function
      (while (beginning-of-defun)
	(imenu-progress-message prev-pos nil t)
	  (and (looking-at ilisp-*defining-form-regexp*)
		 (down-list 1)
		 (cond ((looking-at variable-defining-form-regexp)
			(forward-sexp 2)
			(push (ilisp-imenu-general--name-and-position)
		       ((looking-at type-defining-form-regexp)
			(forward-sexp 2)
			(push (ilisp-imenu-general--name-and-position)
		       ((looking-at function-defining-form-regexp)
			(forward-sexp 2)
			(push (ilisp-imenu-function--name-and-position)
			(forward-sexp 2)
			(push (ilisp-imenu-general--name-and-position)
      (imenu-progress-message prev-pos 100)
      (when index-var-alist
	(push (cons "Variables" index-var-alist) index-fun-alist))
      (when index-type-alist
	(push (cons "Types" index-type-alist) index-fun-alist))
      (when index-unknown-alist
	(push (cons "Syntax-unknown" index-unknown-alist) index-fun-alist))


;; Return the previous+current sexp and the location of the sexp (its
;; beginning) without moving the point.
(defun ilisp-imenu-function--name-and-position ()
    (forward-sexp -1)
    ;; [ydi] modified for imenu-use-markers
    (let* ((beg (if imenu-use-markers (point-marker) (point)))
           (end (progn (forward-sexp) (point)))
           (name (buffer-substring beg end))
           (beg2 (progn (forward-sexp) (forward-sexp -1) (point)))
           (end2 (progn (forward-sexp) (point)))
           (args (buffer-substring beg2 end2)))
      (cons (concat name " " args) 

(defun ilisp-imenu-general--name-and-position ()
    (forward-sexp -1)
    ;; [ydi] modified for imenu-use-markers
    (let ((beg (if imenu-use-markers (point-marker) (point)))
	  (end (progn (forward-sexp) (point))))
      (cons (buffer-substring beg end)

(defun ilisp-imenu-extract-index-name ()
  ;; `imenu-extract-index-name-function' is set to this.
  ;; generates a flat index of definitions in a lisp file.
    (and (looking-at "(def")
	 (condition-case nil
	       (down-list 1)
	       (forward-sexp 2)
	       (let ((beg (point))
		     (end (progn (forward-sexp -1) (point))))
		 (buffer-substring beg end)))
	   (error nil)))))


(defun ilisp-imenu-add-menubar-index ()
  "Add an Imenu \"Index\" entry on the menu bar for the current buffer.

A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
  (imenu-add-to-menubar "Index"))

(add-hook 'lisp-mode-hook
          	  (lambda () 
                    (when (featurep 'imenu)
                      (setq imenu-extract-index-name-function
                      (setq imenu-create-index-function

;;; end of file -- ilisp-imenu.el --