cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-imenu.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-out.el --
   4 ;;;
   5 ;;; This file is part of ILISP.
   6 ;;; Please refer to the file COPYING for copyrights and licensing
   7 ;;; information.
   8 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
   9 ;;; of present and past contributors.
  10 ;;;
  11 ;;; $Id: ilisp-imenu.el,v 1.3 2002-06-03 23:37:01 wbd Exp $
  12
  13
  14 (require 'imenu)
  15
  16 ;;; modified for a better display of function+arglist!
  17 ;;; let tokens contain spaces and test with string-equal.
  18
  19 (defun imenu--completion-buffer (index-alist &optional prompt)
  20   "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
  21
  22 Returns t for rescan and otherwise a position number."
  23   ;; Create a list for this buffer only when needed.
  24   (let ((name (thing-at-point 'symbol))
  25         choice)
  26     (cond (prompt)
  27           ((and name (imenu--in-alist name index-alist))
  28            (setq prompt (format "Index item (default %s): " name)))
  29           (t (setq prompt "Index item: ")))
  30     (if (eq imenu-always-use-completion-buffer-p 'never)
  31         (setq name (completing-read prompt
  32                                     index-alist
  33                                     nil t nil 'imenu--history-list name))
  34       (save-window-excursion
  35         ;; Display the completion buffer
  36         (with-output-to-temp-buffer "*Completions*"
  37           (display-completion-list
  38            (all-completions "" index-alist )))
  39         (let ((minibuffer-setup-hook
  40                (function
  41                 (lambda ()
  42                   (let ((buffer (current-buffer)))
  43                     (save-excursion
  44                       (set-buffer "*Completions*")
  45                       (setq completion-reference-buffer buffer)))))))
  46           ;; Make a completion question
  47           (setq name (completing-read prompt
  48                                       index-alist
  49                                       #'string-equal
  50                                       t nil 'imenu--history-list name)))))
  51     (cond ((not (stringp name))
  52            nil)
  53           ((string= name (car imenu--rescan-item))
  54            t)
  55           (t
  56            (setq choice (assoc name index-alist))
  57            (if (imenu--subalist-p choice)
  58                (imenu--completion-buffer (cdr choice) prompt)
  59              choice)))))
  60 ;;;---
  61
  62 ;;;
  63 ;;; Patch for ilisp-imenu
  64 ;;;
  65
  66 ;; Intent is to allow users to customize what forms can
  67 ;; define types, variables, etc.  At the moment, this is
  68 ;; hardcoded in ilisp-imenu-create-lisp-index.
  69 ;; This file replaces and enhances that. function.
  70
  71 (defvar ilisp-*defining-form-regexp* "^(def"
  72   "Regular expression indicating that the form will define something.")
  73
  74 (defvar ilisp-*type-defining-forms*
  75   '(deftype defstruct defclass define-condition)
  76   "Symbols that announce the definition of a new lisp type.
  77 Don't change this variable -- rather
  78 customize ilisp-*user-type-defining-forms*")
  79
  80 (defvar ilisp-*user-type-defining-forms* nil
  81   "*List of user defined symbols which define new lisp types.")
  82
  83 (defvar ilisp-*variable-defining-forms*
  84   '(defvar defconstant defparameter)
  85   "Symbols that announce the definition of a lisp variable.
  86 Don't change this variable -- rather customize
  87 ilisp-*user-variable-defining-forms*")
  88
  89 (defvar ilisp-*user-variable-defining-forms* nil
  90   "*List of user defined symbols which define new lisp variables.")
  91
  92 (defvar ilisp-*function-defining-forms* '(defun defmethod defmacro defgeneric)
  93   "Symbols that announce the definition of a new new lisp function.
  94 Don't change this variable -- rather customize
  95 ilisp-*user-function-defining-forms*")
  96
  97
  98 (defvar ilisp-*user-function-defining-forms* nil
  99   "*List of user defined symbols which define new lisp functions.")
 100
 101
 102 (defun ilisp-build-optimal-regexp (key)
 103   "Build an optimal regular expression to match tokens used to define
 104 things of class KEY, which can be `:types' or `:variables'."
 105   (regexp-opt (mapcar #'symbol-name
 106                       (remove-duplicates
 107                        (ecase key
 108                          (:types (append ilisp-*type-defining-forms*
 109                                          ilisp-*user-type-defining-forms*))
 110                          (:variables (append ilisp-*variable-defining-forms*
 111                                              ilisp-*user-variable-defining-forms*))
 112                          (:functions (append ilisp-*function-defining-forms*
 113                                              ilisp-*user-function-defining-forms*)))))))
 114
 115
 116 (defun ilisp-imenu-create-lisp-index ()
 117   ;; `imenu-create-index-function' is set to this.
 118   ;; generates a nested index of definitions.
 119   (let ((index-fun-alist '())
 120         (index-var-alist '())
 121         (index-const-alist '())
 122         (index-type-alist '())
 123         (index-unknown-alist '())
 124         (prev-pos nil)
 125         )
 126     (goto-char (point-max))
 127     (imenu-progress-message prev-pos 0)
 128
 129     ;; This will be a bit slower at runtime, but hey, we don't
 130     ;; rebuild the index very often, and at least this way,
 131     ;; we'll get it right.  [ap 13/5/2001]
 132     (let ((type-defining-form-regexp (ilisp-build-optimal-regexp :types))
 133           (variable-defining-form-regexp (ilisp-build-optimal-regexp :variables))
 134           (function-defining-form-regexp (ilisp-build-optimal-regexp :functions)))
 135       ;; Search for the function
 136       (while (beginning-of-defun)
 137         (imenu-progress-message prev-pos nil t)
 138         (save-match-data
 139           (and (looking-at ilisp-*defining-form-regexp*)
 140                (save-excursion
 141                  (down-list 1)
 142                  (cond ((looking-at variable-defining-form-regexp)
 143                         (forward-sexp 2)
 144                         (push (ilisp-imenu-general--name-and-position)
 145                               index-var-alist))
 146                        ((looking-at type-defining-form-regexp)
 147                         (forward-sexp 2)
 148                         (push (ilisp-imenu-general--name-and-position)
 149                               index-type-alist))
 150                        ((looking-at function-defining-form-regexp)
 151                         (forward-sexp 2)
 152                         (push (ilisp-imenu-function--name-and-position)
 153                               index-fun-alist))
 154                        (t
 155                         (forward-sexp 2)
 156                         (push (ilisp-imenu-general--name-and-position)
 157                               index-unknown-alist)))))))
 158       (imenu-progress-message prev-pos 100)
 159       (when index-var-alist
 160         (push (cons "Variables" index-var-alist) index-fun-alist))
 161       (when index-type-alist
 162         (push (cons "Types" index-type-alist) index-fun-alist))
 163       (when index-unknown-alist
 164         (push (cons "Syntax-unknown" index-unknown-alist) index-fun-alist))
 165
 166       index-fun-alist)))
 167
 168
 169 ;; Return the previous+current sexp and the location of the sexp (its
 170 ;; beginning) without moving the point.
 171 (defun ilisp-imenu-function--name-and-position ()
 172   (save-excursion
 173     (forward-sexp -1)
 174     ;; [ydi] modified for imenu-use-markers
 175     (let* ((beg (if imenu-use-markers (point-marker) (point)))
 176            (end (progn (forward-sexp) (point)))
 177            (name (buffer-substring beg end))
 178            (beg2 (progn (forward-sexp) (forward-sexp -1) (point)))
 179            (end2 (progn (forward-sexp) (point)))
 180            (args (buffer-substring beg2 end2)))
 181       (cons (concat name " " args)
 182             beg))))
 183
 184
 185 (defun ilisp-imenu-general--name-and-position ()
 186   (save-excursion
 187     (forward-sexp -1)
 188     ;; [ydi] modified for imenu-use-markers
 189     (let ((beg (if imenu-use-markers (point-marker) (point)))
 190           (end (progn (forward-sexp) (point))))
 191       (cons (buffer-substring beg end)
 192             beg))))
 193
 194
 195 (defun ilisp-imenu-extract-index-name ()
 196   ;; `imenu-extract-index-name-function' is set to this.
 197   ;; generates a flat index of definitions in a lisp file.
 198   (save-match-data
 199     (and (looking-at "(def")
 200          (condition-case nil
 201              (progn
 202                (down-list 1)
 203                (forward-sexp 2)
 204                (let ((beg (point))
 205                      (end (progn (forward-sexp -1) (point))))
 206                  (buffer-substring beg end)))
 207            (error nil)))))
 208
 209 ;;;---
 210
 211 ;;;###autoload
 212 (defun ilisp-imenu-add-menubar-index ()
 213   "Add an Imenu \"Index\" entry on the menu bar for the current buffer.
 214
 215 A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
 216   (interactive)
 217   (imenu-add-to-menubar "Index"))
 218
 219
 220 (add-hook 'lisp-mode-hook
 221                   (lambda ()
 222                     (when (featurep 'imenu)
 223                       (setq imenu-extract-index-name-function
 224                             'ilisp-imenu-extract-index-name)
 225                       (setq imenu-create-index-function
 226                             'ilisp-imenu-create-lisp-index)
 227                       (ilisp-imenu-add-menubar-index))))
 228
 229 ;;; end of file -- ilisp-imenu.el --