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$


;;; Old history log.

;;; 2000-03-03 Martin Atzmueller
;;; use imenu for displaying a fancy function/definition list.


;;; 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))
	choice)
    (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
  				    index-alist
 				    nil t nil 'imenu--history-list name))
      (save-window-excursion
	;; Display the completion buffer
	(with-output-to-temp-buffer "*Completions*"
	  (display-completion-list
	   (all-completions "" index-alist )))
	(let ((minibuffer-setup-hook
	       (function
		(lambda ()
		  (let ((buffer (current-buffer)))
		    (save-excursion
		      (set-buffer "*Completions*")
		      (setq completion-reference-buffer buffer)))))))
	  ;; Make a completion question
	  (setq name (completing-read prompt
				      index-alist
				      #'string-equal
                                      t nil 'imenu--history-list name)))))
    (cond ((not (stringp name))
	   nil)
	  ((string= name (car imenu--rescan-item))
	   t)
	  (t
	   (setq choice (assoc name index-alist))
	   (if (imenu--subalist-p choice)
	       (imenu--completion-buffer (cdr choice) prompt)
	     choice)))))
;;;---

;;;
;;; 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
ilisp-*user-variable-defining-forms*")

(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
ilisp-*user-function-defining-forms*")


(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
		      (remove-duplicates
		       (ecase key
			 (:types (append ilisp-*type-defining-forms*
					 ilisp-*user-type-defining-forms*))
			 (:variables (append ilisp-*variable-defining-forms*
					     ilisp-*user-variable-defining-forms*))
			 (:functions (append ilisp-*function-defining-forms*
					     ilisp-*user-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)
	(save-match-data
	  (and (looking-at ilisp-*defining-form-regexp*)
	       (save-excursion
		 (down-list 1)
		 (cond ((looking-at variable-defining-form-regexp)
			(forward-sexp 2)
			(push (ilisp-imenu-general--name-and-position)
			      index-var-alist))
		       ((looking-at type-defining-form-regexp)
			(forward-sexp 2)
			(push (ilisp-imenu-general--name-and-position)
			      index-type-alist)) 
		       ((looking-at function-defining-form-regexp)
			(forward-sexp 2)
			(push (ilisp-imenu-function--name-and-position)
			      index-fun-alist)) 
		       (t
			(forward-sexp 2)
			(push (ilisp-imenu-general--name-and-position)
			      index-unknown-alist)))))))
      (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))

      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 ()
  (save-excursion
    (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) 
	    beg))))


(defun ilisp-imenu-general--name-and-position ()
  (save-excursion
    (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)
	    beg))))


(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.
  (save-match-data
    (and (looking-at "(def")
	 (condition-case nil
	     (progn
	       (down-list 1)
	       (forward-sexp 2)
	       (let ((beg (point))
		     (end (progn (forward-sexp -1) (point))))
		 (buffer-substring beg end)))
	   (error nil)))))


; (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)
;     (goto-char (point-max))
;     (imenu-progress-message prev-pos 0)
;     ;; Search for the function
;     (while (beginning-of-defun)
;       (imenu-progress-message prev-pos nil t)
; 	  (save-match-data
; 	    (and (looking-at "(def")
; 		 (save-excursion
; 	       (down-list 1)
; 		   (cond
; 		((looking-at "def\\(var\\|constant\\|parameter\\)")
; 		     (forward-sexp 2)
; 		     (push (ilisp-imenu-general--name-and-position)
; 			   index-var-alist))
; 		((looking-at "def\\(un\\|macro\\|method\\|generic\\)")
; 		     (forward-sexp 2)
; 		     (push (ilisp-imenu-function--name-and-position)
; 			   index-fun-alist))
; 		((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)")
; 		     (forward-sexp 2)
;  		 (if (= (char-after (1- (point))) ?\))
; 			 (progn
;  		       (forward-sexp -1)
; 			   (down-list 1)
;  		       (forward-sexp 1)))
; 		     (push (ilisp-imenu-general--name-and-position)
; 			   index-type-alist))
;                 ((looking-at "def")
;                  (forward-sexp 2)
; 		     (push (ilisp-imenu-function--name-and-position)
; 			   index-fun-alist))
; 		    (t
; 		     (forward-sexp 2)
; 		     (push (ilisp-imenu-general--name-and-position)
; 		       index-unknown-alist)))))))
;     (imenu-progress-message prev-pos 100)
;     (and index-var-alist
; 	 (push (cons "Variables" index-var-alist)
; 	       index-fun-alist))
;     (and index-type-alist
;  	 (push (cons "Types" index-type-alist)
;   	       index-fun-alist))
;     (and index-unknown-alist
; 	 (push (cons "Syntax-unknown" index-unknown-alist)
; 	       index-fun-alist))
;     index-fun-alist))



;;;---

;;;###autoload
(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."
  (interactive)
  (imenu-add-to-menubar "Index"))


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

;;; end of file -- ilisp-imenu.el --
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.