imenu.el 37.8 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; imenu.el --- Framework for mode-specific buffer indexes.

3
;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6

;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
;;         Lars Lindberg <lli@sypro.cap.se>
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Maintainer: FSF
Richard M. Stallman's avatar
Richard M. Stallman committed
8
;; Created: 8 Feb 1994
Dan Nicolaescu's avatar
Dan Nicolaescu committed
9
;; Keywords: tools convenience
Erik Naggum's avatar
Erik Naggum committed
10 11 12 13

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14 15 16
;; 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.
Erik Naggum's avatar
Erik Naggum committed
17 18

;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
19 20 21
;; 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.
Erik Naggum's avatar
Erik Naggum committed
22

Richard M. Stallman's avatar
Richard M. Stallman committed
23
;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
24 25 26
;; 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28

;;; Commentary:
Erik Naggum's avatar
Erik Naggum committed
29

Richard M. Stallman's avatar
Richard M. Stallman committed
30 31 32 33 34
;; Purpose of this package:
;;   To present a framework for mode-specific buffer indexes.
;;   A buffer index is an alist of names and buffer positions.
;;   For instance all functions in a C-file and their positions.
;;
35 36
;;   It is documented in the Emacs Lisp manual.
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
37 38 39 40 41 42 43 44
;; How it works:

;;   A mode-specific function is called to generate the index.  It is
;;   then presented to the user, who can choose from this index.
;;
;;   The package comes with a set of example functions for how to
;;   utilize this package.

45 46 47 48
;;   There are *examples* for index gathering functions/regular
;;   expressions for C/C++ and Lisp/Emacs Lisp but it is easy to
;;   customize for other modes.  A function for jumping to the chosen
;;   index position is also supplied.
Richard M. Stallman's avatar
Richard M. Stallman committed
49

50 51
;;; History:
;;  Thanks go to
Richard M. Stallman's avatar
Richard M. Stallman committed
52 53
;;  [simon] - Simon Leinen simon@lia.di.epfl.ch
;;  [dean] - Dean Andrews ada@unison.com
54
;;  [alon] - Alon Albert al@mercury.co.il
55
;;  [greg] - Greg Thompson gregt@porsche.visix.COM
56
;;  [wolfgang] - Wolfgang Bangerth zcg51122@rpool1.rus.uni-stuttgart.de
57
;;  [kai] - Kai Grossjohann grossjoh@linus.informatik.uni-dortmund.de
58
;;  [david] - David M. Smith dsmith@stats.adelaide.edu.au
59 60 61
;;  [christian] - Christian Egli Christian.Egli@hcsd.hac.com
;;  [karl] - Karl Fogel kfogel@floss.life.uiuc.edu

Richard M. Stallman's avatar
Richard M. Stallman committed
62
;;; Code
Erik Naggum's avatar
Erik Naggum committed
63

64
(eval-when-compile (require 'cl))
Richard M. Stallman's avatar
Richard M. Stallman committed
65 66 67 68 69 70

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Customizable variables
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71

72 73 74
(defgroup imenu nil
  "Mode-specific buffer indexes."
  :group 'matching
75
  :group 'frames
Dan Nicolaescu's avatar
Dan Nicolaescu committed
76
  :group 'convenience
77
  :link '(custom-manual "(elisp)Imenu"))
78 79

(defcustom imenu-use-markers t
80
  "*Non-nil means use markers instead of integers for Imenu buffer positions.
81 82 83

Setting this to nil makes Imenu work a little faster but editing the
buffer will make the generated index positions wrong.
84

85 86 87 88
This might not yet be honored by all index-building functions."
  :type 'boolean
  :group 'imenu)

89

90 91
(defcustom imenu-max-item-length 60
  "*If a number, truncate Imenu entries to that length."
92 93
  :type '(choice integer
		 (const :tag "Unlimited"))
94
  :group 'imenu)
95

96
(defcustom imenu-auto-rescan nil
97 98 99
  "*Non-nil means Imenu should always rescan the buffers."
  :type 'boolean
  :group 'imenu)
100

101 102
(defcustom imenu-auto-rescan-maxout 60000
  "*Imenu auto-rescan is disabled in buffers larger than this size (in bytes).
103 104 105
This variable is buffer-local."
  :type 'integer
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
106

107
(defcustom imenu-always-use-completion-buffer-p nil
Richard M. Stallman's avatar
Richard M. Stallman committed
108 109
  "*Set this to non-nil for displaying the index in a completion buffer.

110 111 112
`never' means never automatically display a listing of any kind.
A value of nil (the default) means display the index as a mouse menu
if the mouse was used to invoke `imenu'.
113 114 115
Another non-nil value means always display the index in a completion buffer."
  :type '(choice (const :tag "On Mouse" nil)
		 (const :tag "Never" never)
116
		 (other :tag "Always" t))
117
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
118

119 120 121 122 123 124 125 126
(defcustom imenu-after-jump-hook nil
  "*Hooks called after jumping to a place in the buffer.

Useful things to use here include `reposition-window', `recenter', and
\(lambda () (recenter 0)) to show at top of screen."
  :type 'hook
  :group 'imenu)

127
;;;###autoload
128
(defcustom imenu-sort-function nil
Richard M. Stallman's avatar
Richard M. Stallman committed
129 130 131 132 133 134 135 136
  "*The function to use for sorting the index mouse-menu.

Affects only the mouse index menu.

Set this to nil if you don't want any sorting (faster).
The items in the menu are then presented in the order they were found
in the buffer.

137
Set it to `imenu--sort-by-name' if you want alphabetic sorting.
Richard M. Stallman's avatar
Richard M. Stallman committed
138

139
The function should take two arguments and return t if the first
Richard M. Stallman's avatar
Richard M. Stallman committed
140
element should come before the second.  The arguments are cons cells;
141
\(NAME . POSITION).  Look at `imenu--sort-by-name' for an example."
142
  :type '(choice (const :tag "No sorting" nil)
143
		 (const :tag "Sort by name" imenu--sort-by-name)
144
		 (function :tag "Another function"))
145
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
146

147 148 149 150
(defcustom imenu-max-items 25
  "*Maximum number of elements in a mouse menu for Imenu."
  :type 'integer
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
151

152
(defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
Richard M. Stallman's avatar
Richard M. Stallman committed
153
  "*Progress message during the index scanning of the buffer.
154
If non-nil, user gets a message during the scanning of the buffer.
Richard M. Stallman's avatar
Richard M. Stallman committed
155 156

Relevant only if the mode-specific function that creates the buffer
157 158 159 160
index use `imenu-progress-message', and not useful if that is fast, in
which case you might as well set this to nil."
  :type '(choice string
		 (const :tag "None" nil))
161
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
162

163
(defcustom imenu-space-replacement "."
Richard M. Stallman's avatar
Richard M. Stallman committed
164
  "*The replacement string for spaces in index names.
165
Used when presenting the index in a completion buffer to make the
166 167 168
names work as tokens."
  :type 'string
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
169

170
(defcustom imenu-level-separator ":"
Richard M. Stallman's avatar
Richard M. Stallman committed
171 172
  "*The separator between index names of different levels.
Used for making mouse-menu titles and for flattening nested indexes
173 174 175
with name concatenation."
  :type 'string
  :group 'imenu)
Richard M. Stallman's avatar
Richard M. Stallman committed
176

177
;;;###autoload
178
(defvar imenu-generic-expression nil
179 180
  "The regex pattern to use for creating a buffer index.

181
If non-nil this pattern is passed to `imenu--generic-function'
182 183
to create a buffer index.

184 185 186 187 188 189
The value should be an alist with elements that look like this:
 (MENU-TITLE REGEXP INDEX)
or like this:
 (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
with zero or more ARGUMENTS.  The former format creates a simple element in
the index alist when it matches; the latter creates a special element
190
of the form  (NAME FUNCTION POSITION-MARKER ARGUMENTS...)
191
with FUNCTION and ARGUMENTS beiong copied from `imenu-generic-expression'.
192 193 194 195 196

MENU-TITLE is a string used as the title for the submenu or nil if the
entries are not nested.

REGEXP is a regexp that should match a construct in the buffer that is
197 198 199
to be displayed in the menu; i.e., function or variable definitions,
etc.  It contains a substring which is the name to appear in the
menu.  See the info section on Regexps for more information.
200 201 202

INDEX points to the substring in REGEXP that contains the name (of the
function, variable or type) that is to appear in the menu.
203

204 205 206
The variable is buffer-local.

The variable `imenu-case-fold-search' determines whether or not the
207 208 209 210 211 212 213
regexp matches are case sensitive. and `imenu-syntax-alist' can be
used to alter the syntax table for the search.

For example, see the value of `lisp-imenu-generic-expression' used by
`lisp-mode' and `emacs-lisp-mode' with `imenu-syntax-alist' set
locally to give the characters which normally have \"punctuation\"
syntax \"word\" syntax during matching.")
214

215
;;;###autoload
216
(make-variable-buffer-local 'imenu-generic-expression)
217

Richard M. Stallman's avatar
Richard M. Stallman committed
218 219
;;;; Hooks

220
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
221 222 223 224
(defvar imenu-create-index-function 'imenu-default-create-index-function
  "The function to use for creating a buffer index.

It should be a function that takes no arguments and returns an index
225 226 227
of the current buffer as an alist.

Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
228
Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...).
229 230
A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
The function `imenu--subalist-p' tests an element and returns t
231
if it is a sub-alist.
Richard M. Stallman's avatar
Richard M. Stallman committed
232

233
This function is called within a `save-excursion'.
Richard M. Stallman's avatar
Richard M. Stallman committed
234 235

The variable is buffer-local.")
236
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
237 238
(make-variable-buffer-local 'imenu-create-index-function)

239
;;;###autoload
240
(defvar imenu-prev-index-position-function 'beginning-of-defun
Richard M. Stallman's avatar
Richard M. Stallman committed
241 242
  "Function for finding the next index position.

243 244
If `imenu-create-index-function' is set to
`imenu-default-create-index-function', then you must set this variable
Richard M. Stallman's avatar
Richard M. Stallman committed
245 246 247 248
to a function that will find the next index, looking backwards in the
file.

The function should leave point at the place to be connected to the
249 250 251
index and it should return nil when it doesn't find another index.

This variable is local in all buffers.")
252
;;;###autoload
253
(make-variable-buffer-local 'imenu-prev-index-position-function)
Richard M. Stallman's avatar
Richard M. Stallman committed
254

255
;;;###autoload
256
(defvar imenu-extract-index-name-function nil
257
  "Function for extracting the index item name, given a position.
258 259 260 261 262 263

This function is called after `imenu-prev-index-position-function'
finds a position for an index item, with point at that position.
It should return the name for that index item.

This variable is local in all buffers.")
264
;;;###autoload
265
(make-variable-buffer-local 'imenu-extract-index-name-function)
Richard M. Stallman's avatar
Richard M. Stallman committed
266

267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
;;;###autoload
(defvar imenu-name-lookup-function nil
  "Function to compare string with index item.

This function will be called with two strings, and should return
non-nil if they match.

If nil, comparison is done with `string='.
Set this to some other function for more advanced comparisons,
such as \"begins with\" or \"name matches and number of
arguments match\".

This variable is local in all buffers.")
;;;###autoload
(make-variable-buffer-local 'imenu-name-lookup-function)

283
;;;###autoload
284 285 286
(defvar imenu-default-goto-function 'imenu-default-goto-function
  "The default function called when selecting an Imenu item.
The function in this variable is called when selecting a normal index-item.")
287
;;;###autoload
288 289 290
(make-variable-buffer-local 'imenu-default-goto-function)


291 292
(defun imenu--subalist-p (item)
  (and (consp (cdr item)) (listp (cadr item))
293
       (not (eq (car (cadr item)) 'lambda))))
294

295 296 297 298 299
;; Macro to display a progress message.
;; RELPOS is the relative position to display.
;; If RELPOS is nil, then the relative position in the buffer
;; is calculated.
;; PREVPOS is the variable in which we store the last position displayed.
300
(defmacro imenu-progress-message (prevpos &optional relpos reverse)
301 302 303 304 305 306 307 308 309 310
  `(and
    imenu-scanning-message
    (let ((pos ,(if relpos
		    relpos
		  `(imenu--relative-position ,reverse))))
      (if ,(if relpos t
	     `(> pos (+ 5 ,prevpos)))
	  (progn
	    (message imenu-scanning-message pos)
	    (setq ,prevpos pos))))))
311 312 313 314 315 316 317 318 319


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Some examples of functions utilizing the framework of this
;;;; package.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Karl Heuer's avatar
Karl Heuer committed
320
;; Return the current/previous sexp and the location of the sexp (its
321 322 323 324
;; beginning) without moving the point.
(defun imenu-example--name-and-position ()
  (save-excursion
    (forward-sexp -1)
325 326 327
    ;; [ydi] modified for imenu-use-markers
    (let ((beg (if imenu-use-markers (point-marker) (point)))
	  (end (progn (forward-sexp) (point))))
328
      (cons (buffer-substring beg end)
329
	    beg))))
330 331 332

;;;
;;; Lisp
333
;;;
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361

(defun imenu-example--lisp-extract-index-name ()
  ;; Example of a candidate for `imenu-extract-index-name-function'.
  ;; This will generate 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 imenu-example--create-lisp-index ()
  ;; Example of a candidate for `imenu-create-index-function'.
  ;; It will generate a nested index of definitions.
  (let ((index-alist '())
	(index-var-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)
362 363 364
	  (save-match-data
	    (and (looking-at "(def")
		 (save-excursion
365
	       (down-list 1)
366
		   (cond
367
		((looking-at "def\\(var\\|const\\)")
368 369 370
		     (forward-sexp 2)
		     (push (imenu-example--name-and-position)
			   index-var-alist))
371
		((looking-at "def\\(un\\|subst\\|macro\\|advice\\)")
372 373 374
		     (forward-sexp 2)
		     (push (imenu-example--name-and-position)
			   index-alist))
375
		((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)")
376
		     (forward-sexp 2)
377
 		 (if (= (char-after (1- (point))) ?\))
378
			 (progn
379
 		       (forward-sexp -1)
380
			   (down-list 1)
381
 		       (forward-sexp 1)))
382 383 384 385 386
		     (push (imenu-example--name-and-position)
			   index-type-alist))
		    (t
		     (forward-sexp 2)
		     (push (imenu-example--name-and-position)
387 388 389
		       index-unknown-alist)))))))
    (imenu-progress-message prev-pos 100)
    (and index-var-alist
390
	 (push (cons "Variables" index-var-alist)
391 392
	       index-alist))
    (and index-type-alist
393
 	 (push (cons "Types" index-type-alist)
394 395
  	       index-alist))
    (and index-unknown-alist
396
	 (push (cons "Syntax-unknown" index-unknown-alist)
397 398 399 400 401
	       index-alist))
    index-alist))

;; Regular expression to find C functions
(defvar imenu-example--function-name-regexp-c
402
  (concat
403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430
   "^[a-zA-Z0-9]+[ \t]?"		; type specs; there can be no
   "\\([a-zA-Z0-9_*]+[ \t]+\\)?"	; more than 3 tokens, right?
   "\\([a-zA-Z0-9_*]+[ \t]+\\)?"
   "\\([*&]+[ \t]*\\)?"			; pointer
   "\\([a-zA-Z0-9_*]+\\)[ \t]*("	; name
   ))

(defun imenu-example--create-c-index (&optional regexp)
  (let ((index-alist '())
	prev-pos char)
    (goto-char (point-min))
    (imenu-progress-message prev-pos 0)
    ;; Search for the function
    (save-match-data
      (while (re-search-forward
	      (or regexp imenu-example--function-name-regexp-c)
	      nil t)
	(imenu-progress-message prev-pos)
	(backward-up-list 1)
	(save-excursion
	  (goto-char (scan-sexps (point) 1))
	  (setq char (following-char)))
	;; Skip this function name if it is a prototype declaration.
	(if (not (eq char ?\;))
	    (push (imenu-example--name-and-position) index-alist))))
    (imenu-progress-message prev-pos 100)
    (nreverse index-alist)))

431

Richard M. Stallman's avatar
Richard M. Stallman committed
432 433 434 435 436 437 438 439 440 441 442
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Internal variables
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; The item to use in the index for rescanning the buffer.
(defconst imenu--rescan-item '("*Rescan*" . -99))

;; The latest buffer index.
;; Buffer local.
443 444 445 446 447 448 449 450
(defvar imenu--index-alist nil
  "The buffer index computed for this buffer in Imenu.
Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...).
A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).

This variable is local in all buffers, once set.")

Richard M. Stallman's avatar
Richard M. Stallman committed
451 452
(make-variable-buffer-local 'imenu--index-alist)

453 454 455
(defvar imenu--last-menubar-index-alist nil
  "The latest buffer index used to update the menu bar menu.")

456 457
(make-variable-buffer-local 'imenu--last-menubar-index-alist)

Richard M. Stallman's avatar
Richard M. Stallman committed
458
;; History list for 'jump-to-function-in-buffer'.
459
;; Making this buffer local caused it not to work!
Richard M. Stallman's avatar
Richard M. Stallman committed
460 461 462 463 464 465 466 467 468 469 470
(defvar imenu--history-list nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Internal support functions
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; Sort function
;;; Sorts the items depending on their index name.
471
;;; An item looks like (NAME . POSITION).
Richard M. Stallman's avatar
Richard M. Stallman committed
472 473 474 475
;;;
(defun imenu--sort-by-name (item1 item2)
  (string-lessp (car item1) (car item2)))

476 477 478
(defun imenu--sort-by-position (item1 item2)
  (< (cdr item1) (cdr item2)))

Richard M. Stallman's avatar
Richard M. Stallman committed
479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511
(defun imenu--relative-position (&optional reverse)
  ;; Support function to calculate relative position in buffer
  ;; Beginning of buffer is 0 and end of buffer is 100
  ;; If REVERSE is non-nil then the beginning is 100 and the end is 0.
  (let ((pos (point))
	(total (buffer-size)))
    (and reverse (setq pos (- total pos)))
    (if (> total 50000)
	;; Avoid overflow from multiplying by 100!
	(/ (1- pos) (max (/ total 100) 1))
      (/ (* 100 (1- pos)) (max total 1)))))

;; Split LIST into sublists of max length N.
;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
(defun imenu--split (list n)
  (let ((remain list)
	(result '())
	(sublist '())
	(i 0))
    (while remain
      (push (pop remain) sublist)
      (incf i)
      (and (= i n)
	   ;; We have finished a sublist
	   (progn (push (nreverse sublist) result)
		  (setq i 0)
		  (setq sublist '()))))
    ;; There might be a sublist (if the length of LIST mod n is != 0)
    ;; that has to be added to the result list.
    (and sublist
	 (push (nreverse sublist) result))
    (nreverse result)))

512 513
;;; Split the alist MENULIST into a nested alist, if it is long enough.
;;; In any case, add TITLE to the front of the alist.
Richard M. Stallman's avatar
Richard M. Stallman committed
514
(defun imenu--split-menu (menulist title)
515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531
  (let (keep-at-top tail)
    (if (memq imenu--rescan-item menulist)
	(setq keep-at-top (cons imenu--rescan-item nil)
	      menulist (delq imenu--rescan-item menulist)))
    (setq tail menulist)
    (while tail
      (if (imenu--subalist-p (car tail))
	  (setq keep-at-top (cons (car tail) keep-at-top)
		menulist (delq (car tail) menulist)))
      (setq tail (cdr tail)))
    (if imenu-sort-function
	(setq menulist
	      (sort
	       (let ((res nil)
		     (oldlist menulist))
		 ;; Copy list method from the cl package `copy-list'
		 (while (consp oldlist) (push (pop oldlist) res))
532 533
		 (if res		; in case, e.g. no functions defined
		     (prog1 (nreverse res) (setcdr res oldlist))))
534 535 536 537 538 539 540 541 542 543 544
	       imenu-sort-function)))
    (if (> (length menulist) imenu-max-items)
	(let ((count 0))
	  (setq menulist
		(mapcar
		 (function
		  (lambda (menu)
		    (cons (format "From: %s" (caar menu)) menu)))
		 (imenu--split menulist imenu-max-items)))))
    (cons title
	  (nconc (nreverse keep-at-top) menulist))))
545 546 547 548

;;; Split up each long alist that are nested within ALIST
;;; into nested alists.
(defun imenu--split-submenus (alist)
549 550 551 552 553 554 555
  (mapcar (function
	   (lambda (elt)
	     (if (and (consp elt)
		      (stringp (car elt))
		      (listp (cdr elt)))
		 (imenu--split-menu (cdr elt) (car elt))
	       elt)))
556
	  alist))
Richard M. Stallman's avatar
Richard M. Stallman committed
557

558 559 560 561 562 563 564 565 566 567 568 569 570 571 572
;;; Truncate all strings in MENULIST to imenu-max-item-length
(defun imenu--truncate-items (menulist)
  (mapcar (function
	   (lambda (item)
	     (cond
	      ((consp (cdr item))
	       (imenu--truncate-items (cdr item)))
	      (t
	       ;; truncate if necessary
	       (if (and (numberp imenu-max-item-length)
			(> (length (car item)) imenu-max-item-length))
		   (setcar item (substring (car item) 0 imenu-max-item-length)))))))
	  menulist))


573
(defun imenu--make-index-alist (&optional noerror)
574 575
  "Create an index-alist for the definitions in the current buffer.

576 577 578
Report an error if the list is empty unless NOERROR is supplied and
non-nil.

579 580 581 582
Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
Special elements look like (INDEX-NAME FUNCTION ARGUMENTS...).
A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
The function `imenu--subalist-p' tests an element and returns t
583
if it is a sub-alist.
584 585 586

There is one simple element with negative POSITION; that's intended
as a way for the user to ask to recalculate the buffer's index alist."
587 588 589 590
  (or (and imenu--index-alist
	   (or (not imenu-auto-rescan)
	       (and imenu-auto-rescan
		    (> (buffer-size)  imenu-auto-rescan-maxout))))
591 592 593 594 595 596 597 598
      ;; Get the index; truncate if necessary
      (progn
	(setq imenu--index-alist
	      (save-excursion
		(save-restriction
		  (widen)
		  (funcall imenu-create-index-function))))
	(imenu--truncate-items imenu--index-alist)))
599
  (or imenu--index-alist noerror
600
      (error "No items suitable for an index found in this buffer"))
601 602
  (or imenu--index-alist
      (setq imenu--index-alist (list nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
603 604
  ;; Add a rescan option to the index.
  (cons imenu--rescan-item imenu--index-alist))
605

606 607
;;; Find all markers in alist and makes
;;; them point nowhere.
608 609 610 611
;;; The top-level call uses nil as the argument;
;;; non-nil arguments are in recursivecalls.
(defvar imenu--cleanup-seen)

612
(defun imenu--cleanup (&optional alist)
613
  ;; If alist is provided use that list.
614 615 616 617 618 619
  ;; If not, empty the table of lists already seen
  ;; and use imenu--index-alist.
  (if alist
      (setq imenu--cleanup-seen (cons alist imenu--cleanup-seen))
    (setq alist imenu--index-alist imenu--cleanup-seen (list alist)))

620
  (and alist
621
       (mapcar
622 623 624 625 626
	(function
	 (lambda (item)
	   (cond
	    ((markerp (cdr item))
	     (set-marker (cdr item) nil))
627 628
	    ;; Don't process one alist twice.
	    ((memq (cdr item) imenu--cleanup-seen))
629
	    ((imenu--subalist-p item)
630
	     (imenu--cleanup (cdr item))))))
631
	alist)
632 633
       t))

634
(defun imenu--create-keymap-2 (alist counter &optional commands)
635 636 637 638 639
  (let ((map nil))
    (mapcar
     (function
      (lambda (item)
	(cond
640
	 ((imenu--subalist-p item)
641 642
	  (append (list (setq counter (1+ counter))
			(car item) 'keymap (car item))
643
		  (imenu--create-keymap-2 (cdr item) (+ counter 10) commands)))
644
	 (t
645 646
	  (let ((end (if commands `(lambda () (interactive)
				     (imenu--menubar-select ',item))
647
		       (cons '(nil) item))))
648
	    (cons (car item)
649
		  (cons (car item) end)))))))
650 651
     alist)))

652 653 654 655 656
;; If COMMANDS is non-nil, make a real keymap
;; with a real command used as the definition.
;; If it is nil, make something suitable for x-popup-menu.
(defun imenu--create-keymap-1 (title alist &optional commands)
  (append (list 'keymap title) (imenu--create-keymap-2 alist 0 commands)))
657 658 659 660 661 662

(defun imenu--in-alist (str alist)
  "Check whether the string STR is contained in multi-level ALIST."
  (let (elt head tail res)
    (setq res nil)
    (while alist
663
      (setq elt (car alist)
664
	    tail (cdr elt)
665 666
	    alist (cdr alist)
	    head (car elt))
667 668 669 670 671 672 673 674 675
      ;; A nested ALIST element looks like
      ;;   (INDEX-NAME (INDEX-NAME . INDEX-POSITION) ...)
      ;; while a bottom-level element looks like
      ;;   (INDEX-NAME . INDEX-POSITION)
      ;; We are only interested in the bottom-level elements, so we need to
      ;; recurse if TAIL is a list.
      (cond ((listp tail)
	     (if (setq res (imenu--in-alist str tail))
		 (setq alist nil)))
676 677 678
	    ((if imenu-name-lookup-function
                 (funcall imenu-name-lookup-function str head)
               (string= str head))
679
	     (setq alist nil res elt))))
680 681
    res))

682 683 684 685 686 687 688 689
(defvar imenu-syntax-alist nil
  "Alist of syntax table modifiers to use while executing `imenu--generic-function'.

The car of the assocs may be either a character or a string and the
cdr is a syntax description appropriate fo `modify-syntax-entry'.  For
a string, all the characters in the string get the specified syntax.

This is typically used to give word syntax to characters which
Dave Love's avatar
Dave Love committed
690
normally have symbol syntax to simplify `imenu-expression'
691 692 693
and speed-up matching.")
(make-variable-buffer-local 'imenu-syntax-alist)

Richard M. Stallman's avatar
Richard M. Stallman committed
694 695 696 697
(defun imenu-default-create-index-function ()
  "*Wrapper for index searching functions.

Moves point to end of buffer and then repeatedly calls
698
`imenu-prev-index-position-function' and `imenu-extract-index-name-function'.
Richard M. Stallman's avatar
Richard M. Stallman committed
699
Their results are gathered into an index alist."
700 701
  ;; These should really be done by setting imenu-create-index-function
  ;; in these major modes.  But save that change for later.
702 703
  (cond ((and imenu-prev-index-position-function
	      imenu-extract-index-name-function)
704
	 (let ((index-alist '())
705
	       prev-pos name)
706
	   (goto-char (point-max))
707
	   (imenu-progress-message prev-pos 0 t)
708
	   ;; Search for the function
709
	   (while (funcall imenu-prev-index-position-function)
710
	     (imenu-progress-message prev-pos nil t)
711 712 713
	     (save-excursion
	       (setq name (funcall imenu-extract-index-name-function)))
	     (and (stringp name)
714 715 716
 		  ;; [ydi] updated for imenu-use-markers
		  (push (cons name (if imenu-use-markers (point-marker) (point)))
			index-alist)))
717
	   (imenu-progress-message prev-pos 100 t)
718 719 720
	   index-alist))
	;; Use generic expression if possible.
	((and imenu-generic-expression)
721
	 (imenu--generic-function imenu-generic-expression))
722
	(t
723
	 (error "This buffer cannot use `imenu-default-create-index-function'"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
724 725 726 727 728 729 730 731 732 733 734 735 736

(defun imenu--replace-spaces (name replacement)
  ;; Replace all spaces in NAME with REPLACEMENT.
  ;; That second argument should be a string.
  (mapconcat
   (function
    (lambda (ch)
      (if (char-equal ch ?\ )
	  replacement
	(char-to-string ch))))
   name
   ""))

737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756
;; Not used and would require cl at run time
;;; (defun imenu--flatten-index-alist (index-alist &optional concat-names prefix)
;;;   ;; Takes a nested INDEX-ALIST and returns a flat index alist.
;;;   ;; If optional CONCAT-NAMES is non-nil, then a nested index has its
;;;   ;; name and a space concatenated to the names of the children.
;;;   ;; Third argument PREFIX is for internal use only.
;;;   (mapcan
;;;    (lambda (item)
;;;      (let* ((name (car item))
;;; 	    (pos (cdr item))
;;; 	    (new-prefix (and concat-names
;;; 			     (if prefix
;;; 				 (concat prefix imenu-level-separator name)
;;; 			       name))))
;;;        (cond
;;; 	((or (markerp pos) (numberp pos))
;;; 	 (list (cons new-prefix pos)))
;;; 	(t
;;; 	 (imenu--flatten-index-alist pos new-prefix)))))
;;;    index-alist))
Richard M. Stallman's avatar
Richard M. Stallman committed
757

758 759 760
;;;
;;; Generic index gathering function.
;;;
761

762 763 764 765 766 767 768
(defvar imenu-case-fold-search t
  "Defines whether `imenu--generic-function' should fold case when matching.

This buffer-local variable should be set (only) by initialization code
for modes which use `imenu--generic-function'.  If it is not set, that
function will use the current value of `case-fold-search' to match
patterns.")
769
;;;###autoload
770 771
(make-variable-buffer-local 'imenu-case-fold-search)

772 773
;; Originally "Built on some ideas that Erik Naggum <erik@naggum.no>
;; once posted to comp.emacs" but since substantially re-written.
774 775 776
(defun imenu--generic-function (patterns)
  "Return an index of the current buffer as an alist.

777 778
PATTERNS is an alist with elements that look like this:
 (MENU-TITLE REGEXP INDEX).
779 780 781 782 783

MENU-TITLE is a string used as the title for the submenu or nil if the
entries are not nested.

REGEXP is a regexp that should match a construct in the buffer that is
784 785 786
to be displayed in the menu; i.e., function or variable definitions,
etc.  It contains a substring which is the name to appear in the
menu.  See the info section on Regexps for more information.
787 788 789 790

INDEX points to the substring in REGEXP that contains the name (of the
function, variable or type) that is to appear in the menu.

791
See `lisp-imenu-generic-expression' for an example of PATTERNS.
792

793 794
Returns an index of the current buffer as an alist.  The elements in
the alist look like: (INDEX-NAME . INDEX-POSITION).  They may also be
795
nested index lists like (INDEX-NAME . INDEX-ALIST) depending on
796
PATTERNS."
797 798

  (let ((index-alist (list 'dummy))
799
	prev-pos beg
800 801 802 803 804 805
        (case-fold-search imenu-case-fold-search)
        (old-table (syntax-table))
        (table (copy-syntax-table (syntax-table)))
        (slist imenu-syntax-alist))
    ;; Modify the syntax table used while matching regexps.
    (while slist
806 807 808 809 810 811 812 813
      ;; The character(s) to modify may be a single char or a string.
      (if (numberp (caar slist))
	  (modify-syntax-entry (caar slist) (cdar slist) table)
	(mapcar (function
		 (lambda (c)
		   (modify-syntax-entry c (cdar slist) table)))
		(caar slist)))
      (setq slist (cdr slist)))
814 815
    (goto-char (point-max))
    (imenu-progress-message prev-pos 0 t)
816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846
    (unwind-protect			; for syntax table
	(save-match-data
	  (set-syntax-table table)
	  ;; map over the elements of imenu-generic-expression
	  ;; (typically functions, variables ...)
	  (mapcar
	   (function
	    (lambda (pat)
	      (let ((menu-title (car pat))
		    (regexp (nth 1 pat))
		    (index (nth 2 pat))
		    (function (nth 3 pat))
		    (rest (nthcdr 4 pat)))
		;; Go backwards for convenience of adding items in order.
		(goto-char (point-max))
		(while (re-search-backward regexp nil t)
		  (imenu-progress-message prev-pos nil t)
		  (setq beg (match-beginning index))
		  ;; Add this sort of submenu only when we've found an
		  ;; item for it, avoiding empty, duff menus.
		  (unless (assoc menu-title index-alist)
		    (push (list menu-title) index-alist))
		  (if imenu-use-markers
		      (setq beg (set-marker (make-marker) beg)))
		  (let ((item
			 (if function
			     (nconc (list (match-string-no-properties index)
					  beg function)
				    rest)
			   (cons (match-string-no-properties index)
				 beg)))
847 848 849 850 851 852 853
			;; This is the desired submenu,
			;; starting with its title (or nil).
			(menu (assoc menu-title index-alist)))
		    ;; Insert the item unless it is already present.
		    (unless (member item (cdr menu))
		      (setcdr menu
			      (cons item (cdr menu)))))))))
854 855
	   patterns)
	  (set-syntax-table old-table)))
856
    (imenu-progress-message prev-pos 100 t)
857 858 859 860 861 862 863 864
    ;; Sort each submenu by position.
    ;; This is in case one submenu gets items from two different regexps.
    (let ((tail index-alist))
      (while tail
	(if (listp (car tail))
	    (setcdr (car tail)
		    (sort (cdr (car tail)) 'imenu--sort-by-position)))
	(setq tail (cdr tail))))
865
    (let ((main-element (assq nil index-alist)))
866 867
      (nconc (delq main-element (delq 'dummy index-alist))
	     (cdr main-element)))))
868

Richard M. Stallman's avatar
Richard M. Stallman committed
869 870 871 872 873 874 875 876 877 878 879
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The main functions for this package!
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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.
880 881 882 883 884 885 886 887 888 889 890 891 892
  (let ((name (thing-at-point 'symbol))
	choice
	(prepared-index-alist
	 (mapcar
	  (function
	   (lambda (item)
	     (cons (imenu--replace-spaces (car item) imenu-space-replacement)
		   (cdr item))))
	  index-alist)))
    (cond (prompt)
	  ((and name (imenu--in-alist name prepared-index-alist))
	   (setq prompt (format "Index item (default %s): " name)))
	  (t (setq prompt "Index item: ")))
893
    (if (eq imenu-always-use-completion-buffer-p 'never)
894
  	(setq name (completing-read prompt
895
  				    prepared-index-alist
896
 				    nil t nil 'imenu--history-list name))
897 898 899 900 901 902
      (save-window-excursion
	;; Display the completion buffer
	(with-output-to-temp-buffer "*Completions*"
	  (display-completion-list
	   (all-completions "" prepared-index-alist )))
	(let ((minibuffer-setup-hook
903 904 905 906 907 908
	       (function
		(lambda ()
		  (let ((buffer (current-buffer)))
		    (save-excursion
		      (set-buffer "*Completions*")
		      (setq completion-reference-buffer buffer)))))))
909
	  ;; Make a completion question
910
	  (setq name (completing-read prompt
911
				      prepared-index-alist
912
				      nil t nil 'imenu--history-list name)))))
913 914 915 916 917 918
    (cond ((not (stringp name))
	   nil)
	  ((string= name (car imenu--rescan-item))
	   t)
	  (t
	   (setq choice (assoc name prepared-index-alist))
919
	   (if (imenu--subalist-p choice)
920 921
	       (imenu--completion-buffer (cdr choice) prompt)
	     choice)))))
922

Richard M. Stallman's avatar
Richard M. Stallman committed
923 924 925 926 927
(defun imenu--mouse-menu (index-alist event &optional title)
  "Let the user select from a buffer index from a mouse menu.

INDEX-ALIST is the buffer index and EVENT is a mouse event.

928
Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."
929
  (setq index-alist (imenu--split-submenus index-alist))
930
  (let* ((menu 	(imenu--split-menu index-alist
931 932 933
				   (or title (buffer-name))))
	position)
    (setq menu (imenu--create-keymap-1 (car menu)
934 935
				       (if (< 1 (length (cdr menu)))
					   (cdr menu)
936
					 (cdr (car (cdr menu))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
937
    (setq position (x-popup-menu event menu))
938 939 940 941 942
    (cond ((eq position nil)
	   position)
	  ;; If one call to x-popup-menu handled the nested menus,
	  ;; find the result by looking down the menus here.
	  ((and (listp position)
943 944
		(numberp (car position))
		(stringp (nth (1- (length position)) position)))
945 946
	   (let ((final menu))
	     (while position
947
	       (setq final (assq (car position) final))
948
	       (setq position (cdr position)))
949
             (or (string= (car final) (car imenu--rescan-item))
950
                 (nthcdr 3 final))))
951 952 953 954
	  ;; If x-popup-menu went just one level and found a leaf item,
	  ;; return the INDEX-ALIST element for that.
	  ((and (consp position)
		(stringp (car position))
955
		(null (cdr position)))
956 957 958 959 960
	   (or (string= (car position) (car imenu--rescan-item))
	       (assq (car position) index-alist)))
	  ;; If x-popup-menu went just one level
	  ;; and found a non-leaf item (a submenu),
	  ;; recurse to handle the rest.
961 962 963 964 965
	  ((listp position)
	   (imenu--mouse-menu position event
			      (if title
				  (concat title imenu-level-separator
					  (car (rassq position index-alist)))
966
				(car (rassq position index-alist))))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
967

Richard M. Stallman's avatar
Richard M. Stallman committed
968
(defun imenu-choose-buffer-index (&optional prompt alist)
Richard M. Stallman's avatar
Richard M. Stallman committed
969 970 971 972 973 974
  "Let the user select from a buffer index and return the chosen index.

If the user originally activated this function with the mouse, a mouse
menu is used.  Otherwise a completion buffer is used and the user is
prompted with PROMPT.

Richard M. Stallman's avatar
Richard M. Stallman committed
975 976 977
If you call this function with index alist ALIST, then it lets the user
select from ALIST.

978
With no index alist ALIST, it calls `imenu--make-index-alist' to
Richard M. Stallman's avatar
Richard M. Stallman committed
979 980
create the index alist.

981
If `imenu-always-use-completion-buffer-p' is non-nil, then the
Richard M. Stallman's avatar
Richard M. Stallman committed
982 983 984
completion buffer is always used, no matter if the mouse was used or
not.

985
The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
Richard M. Stallman's avatar
Richard M. Stallman committed
986
  (let (index-alist
987
	(mouse-triggered (listp last-nonmenu-event))
Richard M. Stallman's avatar
Richard M. Stallman committed
988 989 990 991
	(result t) )
    ;; If selected by mouse, see to that the window where the mouse is
    ;; really is selected.
    (and mouse-triggered
992
	 (not (equal last-nonmenu-event '(menu-bar)))
993
	 (let ((window (posn-window (event-start last-nonmenu-event))))
994
	   (or (framep window) (null window) (select-window window))))
Richard M. Stallman's avatar
Richard M. Stallman committed
995 996
    ;; Create a list for this buffer only when needed.
    (while (eq result t)
Richard M. Stallman's avatar
Richard M. Stallman committed
997
      (setq index-alist (if alist alist (imenu--make-index-alist)))
Richard M. Stallman's avatar
Richard M. Stallman committed
998 999 1000
      (setq result
	    (if (and mouse-triggered
		     (not imenu-always-use-completion-buffer-p))
1001
		(imenu--mouse-menu index-alist last-nonmenu-event)
Richard M. Stallman's avatar
Richard M. Stallman committed
1002 1003
	      (imenu--completion-buffer index-alist prompt)))
      (and (eq result t)
1004
	   (imenu--cleanup)
Richard M. Stallman's avatar
Richard M. Stallman committed
1005 1006 1007
	   (setq imenu--index-alist nil)))
    result))