]> code.delx.au - gnu-emacs/blob - lisp/imenu.el
Update copyright notices for 2013.
[gnu-emacs] / lisp / imenu.el
1 ;;; imenu.el --- framework for mode-specific buffer indexes -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 1994-1998, 2001-2013 Free Software Foundation, Inc.
4
5 ;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
6 ;; Lars Lindberg <lli@sypro.cap.se>
7 ;; Maintainer: FSF
8 ;; Created: 8 Feb 1994
9 ;; Keywords: tools convenience
10
11 ;; This file is part of GNU Emacs.
12
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
17
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26 ;;; Commentary:
27
28 ;; Purpose of this package:
29 ;; To present a framework for mode-specific buffer indexes.
30 ;; A buffer index is an alist of names and buffer positions.
31 ;; For instance all functions in a C-file and their positions.
32 ;;
33 ;; It is documented in the Emacs Lisp manual.
34 ;;
35 ;; How it works:
36
37 ;; A mode-specific function is called to generate the index. It is
38 ;; then presented to the user, who can choose from this index.
39 ;;
40 ;; The package comes with a set of example functions for how to
41 ;; utilize this package.
42
43 ;; There are *examples* for index gathering functions/regular
44 ;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to
45 ;; customize for other modes. A function for jumping to the chosen
46 ;; index position is also supplied.
47
48 ;;; History:
49 ;; Thanks go to
50 ;; [simon] - Simon Leinen simon@lia.di.epfl.ch
51 ;; [dean] - Dean Andrews ada@unison.com
52 ;; [alon] - Alon Albert al@mercury.co.il
53 ;; [greg] - Greg Thompson gregt@porsche.visix.COM
54 ;; [wolfgang] - Wolfgang Bangerth zcg51122@rpool1.rus.uni-stuttgart.de
55 ;; [kai] - Kai Grossjohann grossjoh@linus.informatik.uni-dortmund.de
56 ;; [david] - David M. Smith dsmith@stats.adelaide.edu.au
57 ;; [christian] - Christian Egli Christian.Egli@hcsd.hac.com
58 ;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu
59
60 ;;; Code:
61
62 (eval-when-compile (require 'cl-lib))
63
64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65 ;;;
66 ;;; Customizable variables
67 ;;;
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69
70 (defgroup imenu nil
71 "Mode-specific buffer indexes."
72 :group 'matching
73 :group 'frames
74 :group 'convenience
75 :link '(custom-manual "(elisp)Imenu"))
76
77 (defcustom imenu-use-markers t
78 "Non-nil means use markers instead of integers for Imenu buffer positions.
79
80 Setting this to nil makes Imenu work a little faster but editing the
81 buffer will make the generated index positions wrong.
82
83 This might not yet be honored by all index-building functions."
84 :type 'boolean
85 :group 'imenu)
86
87
88 (defcustom imenu-max-item-length 60
89 "If a number, truncate Imenu entries to that length."
90 :type '(choice integer
91 (const :tag "Unlimited"))
92 :group 'imenu)
93
94 (defcustom imenu-auto-rescan nil
95 "Non-nil means Imenu should always rescan the buffers."
96 :type 'boolean
97 :group 'imenu)
98
99 (defcustom imenu-auto-rescan-maxout 60000
100 "Imenu auto-rescan is disabled in buffers larger than this size (in bytes).
101 This variable is buffer-local."
102 :type 'integer
103 :group 'imenu)
104
105 (defvar imenu-always-use-completion-buffer-p nil)
106 (make-obsolete-variable 'imenu-always-use-completion-buffer-p
107 'imenu-use-popup-menu "22.1")
108
109 (defcustom imenu-use-popup-menu
110 (if imenu-always-use-completion-buffer-p
111 (not (eq imenu-always-use-completion-buffer-p 'never))
112 'on-mouse)
113 "Use a popup menu rather than a minibuffer prompt.
114 If nil, always use a minibuffer prompt.
115 If t, always use a popup menu,
116 If `on-mouse' use a popup menu when `imenu' was invoked with the mouse."
117 :type '(choice (const :tag "On Mouse" on-mouse)
118 (const :tag "Never" nil)
119 (other :tag "Always" t))
120 :group 'imenu)
121
122 (defcustom imenu-eager-completion-buffer
123 (not (eq imenu-always-use-completion-buffer-p 'never))
124 "If non-nil, eagerly popup the completion buffer."
125 :type 'boolean
126 :group 'imenu
127 :version "22.1")
128
129 (defcustom imenu-after-jump-hook nil
130 "Hooks called after jumping to a place in the buffer.
131
132 Useful things to use here include `reposition-window', `recenter', and
133 \(lambda () (recenter 0)) to show at top of screen."
134 :type 'hook
135 :group 'imenu)
136
137 ;;;###autoload
138 (defcustom imenu-sort-function nil
139 "The function to use for sorting the index mouse-menu.
140
141 Affects only the mouse index menu.
142
143 Set this to nil if you don't want any sorting (faster).
144 The items in the menu are then presented in the order they were found
145 in the buffer.
146
147 Set it to `imenu--sort-by-name' if you want alphabetic sorting.
148
149 The function should take two arguments and return t if the first
150 element should come before the second. The arguments are cons cells;
151 \(NAME . POSITION). Look at `imenu--sort-by-name' for an example."
152 :type '(choice (const :tag "No sorting" nil)
153 (const :tag "Sort by name" imenu--sort-by-name)
154 (function :tag "Another function"))
155 :group 'imenu)
156
157 (defcustom imenu-max-items 25
158 "Maximum number of elements in a mouse menu for Imenu."
159 :type 'integer
160 :group 'imenu)
161
162 ;; No longer used. KFS 2004-10-27
163 ;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
164 ;; "Progress message during the index scanning of the buffer.
165 ;; If non-nil, user gets a message during the scanning of the buffer.
166 ;;
167 ;; Relevant only if the mode-specific function that creates the buffer
168 ;; index use `imenu-progress-message', and not useful if that is fast, in
169 ;; which case you might as well set this to nil."
170 ;; :type '(choice string
171 ;; (const :tag "None" nil))
172 ;; :group 'imenu)
173
174 (defcustom imenu-space-replacement "."
175 "The replacement string for spaces in index names.
176 Used when presenting the index in a completion buffer to make the
177 names work as tokens."
178 :type '(choice string (const nil))
179 :group 'imenu)
180
181 (defcustom imenu-level-separator ":"
182 "The separator between index names of different levels.
183 Used for making mouse-menu titles and for flattening nested indexes
184 with name concatenation."
185 :type 'string
186 :group 'imenu)
187
188 ;;;###autoload
189 (defvar imenu-generic-expression nil
190 "List of definition matchers for creating an Imenu index.
191 Each element of this list should have the form
192
193 (MENU-TITLE REGEXP INDEX [FUNCTION] [ARGUMENTS...])
194
195 MENU-TITLE should be nil (in which case the matches for this
196 element are put in the top level of the buffer index) or a
197 string (which specifies the title of a submenu into which the
198 matches are put).
199 REGEXP is a regular expression matching a definition construct
200 which is to be displayed in the menu. REGEXP may also be a
201 function, called without arguments. It is expected to search
202 backwards. It must return true and set `match-data' if it finds
203 another element.
204 INDEX is an integer specifying which subexpression of REGEXP
205 matches the definition's name; this subexpression is displayed as
206 the menu item.
207 FUNCTION, if present, specifies a function to call when the index
208 item is selected by the user. This function is called with
209 arguments consisting of the item name, the buffer position, and
210 the ARGUMENTS.
211
212 The variable `imenu-case-fold-search' determines whether or not
213 the regexp matches are case sensitive, and `imenu-syntax-alist'
214 can be used to alter the syntax table for the search.
215
216 If non-nil this pattern is passed to `imenu--generic-function' to
217 create a buffer index.
218
219 For example, see the value of `fortran-imenu-generic-expression'
220 used by `fortran-mode' with `imenu-syntax-alist' set locally to
221 give the characters which normally have \"symbol\" syntax
222 \"word\" syntax during matching.")
223 ;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t)
224
225 ;;;###autoload
226 (make-variable-buffer-local 'imenu-generic-expression)
227
228 ;;;; Hooks
229
230 ;;;###autoload
231 (defvar imenu-create-index-function 'imenu-default-create-index-function
232 "The function to use for creating an index alist of the current buffer.
233
234 It should be a function that takes no arguments and returns
235 an index alist of the current buffer. The function is
236 called within a `save-excursion'.
237
238 See `imenu--index-alist' for the format of the buffer index alist.")
239 ;;;###autoload
240 (make-variable-buffer-local 'imenu-create-index-function)
241
242 ;;;###autoload
243 (defvar imenu-prev-index-position-function 'beginning-of-defun
244 "Function for finding the next index position.
245
246 If `imenu-create-index-function' is set to
247 `imenu-default-create-index-function', then you must set this variable
248 to a function that will find the next index, looking backwards in the
249 file.
250
251 The function should leave point at the place to be connected to the
252 index and it should return nil when it doesn't find another index.")
253 ;;;###autoload
254 (make-variable-buffer-local 'imenu-prev-index-position-function)
255
256 ;;;###autoload
257 (defvar imenu-extract-index-name-function nil
258 "Function for extracting the index item name, given a position.
259
260 This function is called after `imenu-prev-index-position-function'
261 finds a position for an index item, with point at that position.
262 It should return the name for that index item.")
263 ;;;###autoload
264 (make-variable-buffer-local 'imenu-extract-index-name-function)
265
266 ;;;###autoload
267 (defvar imenu-name-lookup-function nil
268 "Function to compare string with index item.
269
270 This function will be called with two strings, and should return
271 non-nil if they match.
272
273 If nil, comparison is done with `string='.
274 Set this to some other function for more advanced comparisons,
275 such as \"begins with\" or \"name matches and number of
276 arguments match\".")
277 ;;;###autoload
278 (make-variable-buffer-local 'imenu-name-lookup-function)
279
280 ;;;###autoload
281 (defvar imenu-default-goto-function 'imenu-default-goto-function
282 "The default function called when selecting an Imenu item.
283 The function in this variable is called when selecting a normal index-item.")
284 ;;;###autoload
285 (make-variable-buffer-local 'imenu-default-goto-function)
286
287
288 (defun imenu--subalist-p (item)
289 (and (consp (cdr item)) (listp (cadr item))
290 (not (eq (car (cadr item)) 'lambda))))
291
292 (defmacro imenu-progress-message (_prevpos &optional _relpos _reverse)
293 "Macro to display a progress message.
294 RELPOS is the relative position to display.
295 If RELPOS is nil, then the relative position in the buffer
296 is calculated.
297 PREVPOS is the variable in which we store the last position displayed."
298
299 ;; Made obsolete/empty, as computers are now faster than the eye, and
300 ;; it had problems updating the messages correctly, and could shadow
301 ;; more important messages/prompts in the minibuffer. KFS 2004-10-27.
302
303 ;; `(and
304 ;; imenu-scanning-message
305 ;; (let ((pos ,(if relpos
306 ;; relpos
307 ;; `(imenu--relative-position ,reverse))))
308 ;; (if ,(if relpos t
309 ;; `(> pos (+ 5 ,prevpos)))
310 ;; (progn
311 ;; (message imenu-scanning-message pos)
312 ;; (setq ,prevpos pos)))))
313 )
314
315
316 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
317 ;;;;
318 ;;;; Some examples of functions utilizing the framework of this
319 ;;;; package.
320 ;;;;
321 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
322
323 ;; FIXME: This was the only imenu-example-* definition actually used,
324 ;; by cperl-mode.el. Now cperl-mode has its own copy, so these can
325 ;; all be removed.
326 (defun imenu-example--name-and-position ()
327 "Return the current/previous sexp and its (beginning) location.
328 Don't move point."
329 (declare (obsolete "use your own function instead." "23.2"))
330 (save-excursion
331 (forward-sexp -1)
332 ;; [ydi] modified for imenu-use-markers
333 (let ((beg (if imenu-use-markers (point-marker) (point)))
334 (end (progn (forward-sexp) (point))))
335 (cons (buffer-substring beg end)
336 beg))))
337
338 ;;;
339 ;;; Lisp
340 ;;;
341
342 (defun imenu-example--lisp-extract-index-name ()
343 ;; Example of a candidate for `imenu-extract-index-name-function'.
344 ;; This will generate a flat index of definitions in a lisp file.
345 (declare (obsolete nil "23.2"))
346 (save-match-data
347 (and (looking-at "(def")
348 (condition-case nil
349 (progn
350 (down-list 1)
351 (forward-sexp 2)
352 (let ((beg (point))
353 (end (progn (forward-sexp -1) (point))))
354 (buffer-substring beg end)))
355 (error nil)))))
356
357 (defun imenu-example--create-lisp-index ()
358 ;; Example of a candidate for `imenu-create-index-function'.
359 ;; It will generate a nested index of definitions.
360 (declare (obsolete nil "23.2"))
361 (let ((index-alist '())
362 (index-var-alist '())
363 (index-type-alist '())
364 (index-unknown-alist '()))
365 (goto-char (point-max))
366 ;; Search for the function
367 (while (beginning-of-defun)
368 (save-match-data
369 (and (looking-at "(def")
370 (save-excursion
371 (down-list 1)
372 (cond
373 ((looking-at "def\\(var\\|const\\)")
374 (forward-sexp 2)
375 (push (imenu-example--name-and-position)
376 index-var-alist))
377 ((looking-at "def\\(un\\|subst\\|macro\\|advice\\)")
378 (forward-sexp 2)
379 (push (imenu-example--name-and-position)
380 index-alist))
381 ((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)")
382 (forward-sexp 2)
383 (if (= (char-after (1- (point))) ?\))
384 (progn
385 (forward-sexp -1)
386 (down-list 1)
387 (forward-sexp 1)))
388 (push (imenu-example--name-and-position)
389 index-type-alist))
390 (t
391 (forward-sexp 2)
392 (push (imenu-example--name-and-position)
393 index-unknown-alist)))))))
394 (and index-var-alist
395 (push (cons "Variables" index-var-alist)
396 index-alist))
397 (and index-type-alist
398 (push (cons "Types" index-type-alist)
399 index-alist))
400 (and index-unknown-alist
401 (push (cons "Syntax-unknown" index-unknown-alist)
402 index-alist))
403 index-alist))
404
405 ;; Regular expression to find C functions
406 (defvar imenu-example--function-name-regexp-c
407 (concat
408 "^[a-zA-Z0-9]+[ \t]?" ; type specs; there can be no
409 "\\([a-zA-Z0-9_*]+[ \t]+\\)?" ; more than 3 tokens, right?
410 "\\([a-zA-Z0-9_*]+[ \t]+\\)?"
411 "\\([*&]+[ \t]*\\)?" ; pointer
412 "\\([a-zA-Z0-9_*]+\\)[ \t]*(" ; name
413 ))
414
415 (defun imenu-example--create-c-index (&optional regexp)
416 (declare (obsolete nil "23.2"))
417 (let ((index-alist '())
418 char)
419 (goto-char (point-min))
420 ;; Search for the function
421 (save-match-data
422 (while (re-search-forward
423 (or regexp imenu-example--function-name-regexp-c)
424 nil t)
425 (backward-up-list 1)
426 (save-excursion
427 (goto-char (scan-sexps (point) 1))
428 (setq char (following-char)))
429 ;; Skip this function name if it is a prototype declaration.
430 (if (not (eq char ?\;))
431 (push (imenu-example--name-and-position) index-alist))))
432 (nreverse index-alist)))
433
434 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
435 ;;;
436 ;;; Internal variables
437 ;;;
438 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
439
440 ;; The item to use in the index for rescanning the buffer.
441 (defconst imenu--rescan-item '("*Rescan*" . -99))
442
443 ;; The latest buffer index.
444 (defvar-local imenu--index-alist nil
445 "The buffer index alist computed for this buffer in Imenu.
446
447 Simple elements in the alist look like (INDEX-NAME . POSITION).
448 POSITION is the buffer position of the item; to go to the item
449 is simply to move point to that position.
450
451 Special elements look like (INDEX-NAME POSITION FUNCTION ARGUMENTS...).
452 To \"go to\" a special element means applying FUNCTION
453 to INDEX-NAME, POSITION, and the ARGUMENTS.
454
455 A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
456 The function `imenu--subalist-p' tests an element and returns t
457 if it is a sub-alist.
458
459 There is one simple element with negative POSITION; selecting that
460 element recalculates the buffer's index alist.")
461 ;;;###autoload(put 'imenu--index-alist 'risky-local-variable t)
462
463 (defvar-local imenu--last-menubar-index-alist nil
464 "The latest buffer index alist used to update the menu bar menu.")
465
466 (defvar imenu--history-list nil
467 ;; Making this buffer local caused it not to work!
468 "History list for 'jump-to-function-in-buffer'.")
469
470 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
471 ;;;
472 ;;; Internal support functions
473 ;;;
474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
475
476 (defun imenu--sort-by-name (item1 item2)
477 "Comparison function to sort items depending on their index name.
478 An item looks like (NAME . POSITION)."
479 (string-lessp (car item1) (car item2)))
480
481 (defun imenu--sort-by-position (item1 item2)
482 (< (cdr item1) (cdr item2)))
483
484 (defun imenu--relative-position (&optional reverse)
485 "Support function to calculate relative position in buffer.
486 Beginning of buffer is 0 and end of buffer is 100
487 If REVERSE is non-nil then the beginning is 100 and the end is 0."
488 (let ((pos (point))
489 (total (buffer-size)))
490 (and reverse (setq pos (- total pos)))
491 (if (> total 50000)
492 ;; Avoid overflow from multiplying by 100!
493 (/ (1- pos) (max (/ total 100) 1))
494 (/ (* 100 (1- pos)) (max total 1)))))
495
496 (defun imenu--split (list n)
497 "Split LIST into sublists of max length N.
498 Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
499 The returned list DOES NOT share structure with LIST."
500 (let ((remain list)
501 (result '())
502 (sublist '())
503 (i 0))
504 (while remain
505 (push (pop remain) sublist)
506 (cl-incf i)
507 (and (= i n)
508 ;; We have finished a sublist
509 (progn (push (nreverse sublist) result)
510 (setq i 0)
511 (setq sublist '()))))
512 ;; There might be a sublist (if the length of LIST mod n is != 0)
513 ;; that has to be added to the result list.
514 (and sublist
515 (push (nreverse sublist) result))
516 (nreverse result)))
517
518 (defun imenu--split-menu (menulist title)
519 "Split the alist MENULIST into a nested alist, if it is long enough.
520 In any case, add TITLE to the front of the alist.
521 If IMENU--RESCAN-ITEM is present in MENULIST, it is moved to the
522 beginning of the returned alist.
523 The returned alist DOES NOT share structure with MENULIST."
524 (let ((menulist (copy-sequence menulist))
525 keep-at-top)
526 (if (memq imenu--rescan-item menulist)
527 (setq keep-at-top (list imenu--rescan-item)
528 menulist (delq imenu--rescan-item menulist)))
529 (dolist (item menulist)
530 (when (imenu--subalist-p item)
531 (push item keep-at-top)
532 (setq menulist (delq item menulist))))
533 (if imenu-sort-function
534 (setq menulist (sort menulist imenu-sort-function)))
535 (if (> (length menulist) imenu-max-items)
536 (setq menulist
537 (mapcar
538 (lambda (menu)
539 (cons (format "From: %s" (caar menu)) menu))
540 (imenu--split menulist imenu-max-items))))
541 (cons title
542 (nconc (nreverse keep-at-top) menulist))))
543
544 (defun imenu--split-submenus (alist)
545 "Split up each long alist that are nested within ALIST into nested alists.
546 Return a split and sorted copy of ALIST. The returned alist DOES
547 NOT share structure with ALIST."
548 (mapcar (lambda (elt)
549 (if (and (consp elt)
550 (stringp (car elt))
551 (listp (cdr elt)))
552 (imenu--split-menu (cdr elt) (car elt))
553 elt))
554 alist))
555
556 (defun imenu--truncate-items (menulist)
557 "Truncate all strings in MENULIST to `imenu-max-item-length'."
558 (mapcar (lambda (item)
559 (cond
560 ((consp (cdr item))
561 (imenu--truncate-items (cdr item)))
562 ;; truncate if necessary
563 ((and (numberp imenu-max-item-length)
564 (> (length (car item)) imenu-max-item-length))
565 (setcar item (substring (car item) 0 imenu-max-item-length)))))
566 menulist))
567
568
569 (defun imenu--make-index-alist (&optional noerror)
570 "Create an index alist for the definitions in the current buffer.
571 This works by using the hook function `imenu-create-index-function'.
572 Report an error if the list is empty unless NOERROR is supplied and
573 non-nil.
574
575 See `imenu--index-alist' for the format of the index alist."
576 (or (and imenu--index-alist
577 (or (not imenu-auto-rescan)
578 (and imenu-auto-rescan
579 (> (buffer-size) imenu-auto-rescan-maxout))))
580 ;; Get the index; truncate if necessary
581 (progn
582 (setq imenu--index-alist
583 (save-excursion
584 (save-restriction
585 (widen)
586 (funcall imenu-create-index-function))))
587 (imenu--truncate-items imenu--index-alist)))
588 (or imenu--index-alist noerror
589 (user-error "No items suitable for an index found in this buffer"))
590 (or imenu--index-alist
591 (setq imenu--index-alist (list nil)))
592 ;; Add a rescan option to the index.
593 (cons imenu--rescan-item imenu--index-alist))
594
595 (defvar imenu--cleanup-seen nil)
596
597 (defun imenu--cleanup (&optional alist)
598 "Find all markers in ALIST and make them point nowhere.
599 If ALIST is nil (the normal case), use `imenu--index-alist'.
600 Non-nil arguments are in recursive calls."
601 ;; If alist is provided use that list.
602 ;; If not, empty the table of lists already seen
603 ;; and use imenu--index-alist.
604 (if alist
605 (setq imenu--cleanup-seen (cons alist imenu--cleanup-seen))
606 (setq alist imenu--index-alist imenu--cleanup-seen (list alist)))
607
608 (when alist
609 (dolist (item alist)
610 (cond
611 ((markerp (cdr item)) (set-marker (cdr item) nil))
612 ;; Don't process one alist twice.
613 ((memq (cdr item) imenu--cleanup-seen))
614 ((imenu--subalist-p item) (imenu--cleanup (cdr item)))))
615 t))
616
617 (defun imenu--create-keymap (title alist &optional cmd)
618 `(keymap ,title
619 ,@(mapcar
620 (lambda (item)
621 `(,(car item) ,(car item)
622 ,@(cond
623 ((imenu--subalist-p item)
624 (imenu--create-keymap (car item) (cdr item) cmd))
625 (t
626 `(lambda () (interactive)
627 ,(if cmd `(,cmd ',item) (list 'quote item)))))))
628 alist)))
629
630 (defun imenu--in-alist (str alist)
631 "Check whether the string STR is contained in multi-level ALIST."
632 (let (elt head tail res)
633 (setq res nil)
634 (while alist
635 (setq elt (car alist)
636 tail (cdr elt)
637 alist (cdr alist)
638 head (car elt))
639 ;; A nested ALIST element looks like
640 ;; (INDEX-NAME (INDEX-NAME . INDEX-POSITION) ...)
641 ;; while a bottom-level element looks like
642 ;; (INDEX-NAME . INDEX-POSITION)
643 ;; We are only interested in the bottom-level elements, so we need to
644 ;; recurse if TAIL is a list.
645 (cond ((listp tail)
646 (if (setq res (imenu--in-alist str tail))
647 (setq alist nil)))
648 ((if imenu-name-lookup-function
649 (funcall imenu-name-lookup-function str head)
650 (string= str head))
651 (setq alist nil res elt))))
652 res))
653
654 (defvar imenu-syntax-alist nil
655 "Alist of syntax table modifiers to use while in `imenu--generic-function'.
656
657 The car of the assocs may be either a character or a string and the
658 cdr is a syntax description appropriate for `modify-syntax-entry'. For
659 a string, all the characters in the string get the specified syntax.
660
661 This is typically used to give word syntax to characters which
662 normally have symbol syntax to simplify `imenu-expression'
663 and speed-up matching.")
664 ;;;###autoload
665 (make-variable-buffer-local 'imenu-syntax-alist)
666
667 (defun imenu-default-create-index-function ()
668 "Default function to create an index alist of the current buffer.
669
670 The most general method is to move point to end of buffer, then repeatedly call
671 `imenu-prev-index-position-function' and `imenu-extract-index-name-function'.
672 All the results returned by the latter are gathered into an index alist.
673 This method is used if those two variables are non-nil.
674
675 The alternate method, which is the one most often used, is to call
676 `imenu--generic-function' with `imenu-generic-expression' as argument."
677 ;; These should really be done by setting imenu-create-index-function
678 ;; in these major modes. But save that change for later.
679 (cond ((and imenu-prev-index-position-function
680 imenu-extract-index-name-function)
681 (let ((index-alist '()) (pos (point))
682 name)
683 (goto-char (point-max))
684 ;; Search for the function
685 (while (funcall imenu-prev-index-position-function)
686 (when (= pos (point))
687 (error "Infinite loop at %s:%d: imenu-prev-index-position-function does not move point" (buffer-name) pos))
688 (setq pos (point))
689 (save-excursion
690 (setq name (funcall imenu-extract-index-name-function)))
691 (and (stringp name)
692 ;; [ydi] updated for imenu-use-markers
693 (push (cons name (if imenu-use-markers (point-marker) (point)))
694 index-alist)))
695 index-alist))
696 ;; Use generic expression if possible.
697 ((and imenu-generic-expression)
698 (imenu--generic-function imenu-generic-expression))
699 (t
700 (user-error "This buffer cannot use `imenu-default-create-index-function'"))))
701
702 ;;;
703 ;;; Generic index gathering function.
704 ;;;
705
706 (defvar imenu-case-fold-search t
707 "Defines whether `imenu--generic-function' should fold case when matching.
708
709 This variable should be set (only) by initialization code
710 for modes which use `imenu--generic-function'. If it is not set, but
711 `font-lock-defaults' is set, then font-lock's setting is used.")
712 ;;;###autoload
713 (make-variable-buffer-local 'imenu-case-fold-search)
714
715 ;; This function can be called with quitting disabled,
716 ;; so it needs to be careful never to loop!
717 (defun imenu--generic-function (patterns)
718 "Return an index alist of the current buffer based on PATTERNS.
719 PATTERNS should be an alist which has the same form as
720 `imenu-generic-expression'.
721
722 The return value is an alist of the form
723 (INDEX-NAME . INDEX-POSITION)
724 or
725 (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...)
726 The return value may also consist of nested index alists like:
727 (INDEX-NAME . INDEX-ALIST)
728 depending on PATTERNS."
729 (let ((index-alist (list 'dummy))
730 (case-fold-search (if (or (local-variable-p 'imenu-case-fold-search)
731 (not (local-variable-p 'font-lock-defaults)))
732 imenu-case-fold-search
733 (nth 2 font-lock-defaults)))
734 (old-table (syntax-table))
735 (table (copy-syntax-table (syntax-table)))
736 (slist imenu-syntax-alist))
737 ;; Modify the syntax table used while matching regexps.
738 (dolist (syn slist)
739 ;; The character(s) to modify may be a single char or a string.
740 (if (numberp (car syn))
741 (modify-syntax-entry (car syn) (cdr syn) table)
742 (mapc (lambda (c)
743 (modify-syntax-entry c (cdr syn) table))
744 (car syn))))
745 (goto-char (point-max))
746 (unwind-protect ; for syntax table
747 (save-match-data
748 (set-syntax-table table)
749
750 ;; map over the elements of imenu-generic-expression
751 ;; (typically functions, variables ...)
752 (dolist (pat patterns)
753 (let ((menu-title (car pat))
754 (regexp (nth 1 pat))
755 (index (nth 2 pat))
756 (function (nth 3 pat))
757 (rest (nthcdr 4 pat))
758 start beg)
759 ;; Go backwards for convenience of adding items in order.
760 (goto-char (point-max))
761 (while (and (if (functionp regexp)
762 (funcall regexp)
763 (and
764 (re-search-backward regexp nil t)
765 ;; Do not count invisible definitions.
766 (let ((invis (invisible-p (point))))
767 (or (not invis)
768 (progn
769 (while (and invis
770 (not (bobp)))
771 (setq invis (not (re-search-backward
772 regexp nil 'move))))
773 (not invis))))))
774 ;; Exit the loop if we get an empty match,
775 ;; because it means a bad regexp was specified.
776 (not (= (match-beginning 0) (match-end 0))))
777 (setq start (point))
778 ;; Record the start of the line in which the match starts.
779 ;; That's the official position of this definition.
780 (goto-char (match-beginning index))
781 (beginning-of-line)
782 (setq beg (point))
783 ;; Add this sort of submenu only when we've found an
784 ;; item for it, avoiding empty, duff menus.
785 (unless (assoc menu-title index-alist)
786 (push (list menu-title) index-alist))
787 (if imenu-use-markers
788 (setq beg (copy-marker beg)))
789 (let ((item
790 (if function
791 (nconc (list (match-string-no-properties index)
792 beg function)
793 rest)
794 (cons (match-string-no-properties index)
795 beg)))
796 ;; This is the desired submenu,
797 ;; starting with its title (or nil).
798 (menu (assoc menu-title index-alist)))
799 ;; Insert the item unless it is already present.
800 (unless (member item (cdr menu))
801 (setcdr menu
802 (cons item (cdr menu)))))
803 ;; Go to the start of the match, to make sure we
804 ;; keep making progress backwards.
805 (goto-char start))))
806 (set-syntax-table old-table)))
807 ;; Sort each submenu by position.
808 ;; This is in case one submenu gets items from two different regexps.
809 (dolist (item index-alist)
810 (when (listp item)
811 (setcdr item (sort (cdr item) 'imenu--sort-by-position))))
812 (let ((main-element (assq nil index-alist)))
813 (nconc (delq main-element (delq 'dummy index-alist))
814 (cdr main-element)))))
815
816 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
817 ;;;
818 ;;; The main functions for this package!
819 ;;;
820 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
821
822 ;; See also info-lookup-find-item
823 (defun imenu-find-default (guess completions)
824 "Fuzzily find an item based on GUESS inside the alist COMPLETIONS."
825 (catch 'found
826 (let ((case-fold-search t))
827 (if (assoc guess completions) guess
828 (dolist (re (list (concat "\\`" (regexp-quote guess) "\\'")
829 (concat "\\`" (regexp-quote guess))
830 (concat (regexp-quote guess) "\\'")
831 (regexp-quote guess)))
832 (dolist (x completions)
833 (if (string-match re (car x)) (throw 'found (car x)))))))))
834
835 (defun imenu--completion-buffer (index-alist &optional prompt)
836 "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
837
838 Return one of the entries in index-alist or nil."
839 ;; Create a list for this buffer only when needed.
840 (let ((name (thing-at-point 'symbol))
841 choice
842 (prepared-index-alist
843 (if (not imenu-space-replacement) index-alist
844 (mapcar
845 (lambda (item)
846 (cons (subst-char-in-string ?\s (aref imenu-space-replacement 0)
847 (car item))
848 (cdr item)))
849 index-alist))))
850 (when (stringp name)
851 (setq name (or (imenu-find-default name prepared-index-alist) name)))
852 (cond (prompt)
853 ((and name (imenu--in-alist name prepared-index-alist))
854 (setq prompt (format "Index item (default %s): " name)))
855 (t (setq prompt "Index item: ")))
856 (let ((minibuffer-setup-hook minibuffer-setup-hook))
857 ;; Display the completion buffer.
858 (if (not imenu-eager-completion-buffer)
859 (add-hook 'minibuffer-setup-hook 'minibuffer-completion-help))
860 (setq name (completing-read prompt
861 prepared-index-alist
862 nil t nil 'imenu--history-list name)))
863
864 (when (stringp name)
865 (setq choice (assoc name prepared-index-alist))
866 (if (imenu--subalist-p choice)
867 (imenu--completion-buffer (cdr choice) prompt)
868 choice))))
869
870 (defun imenu--mouse-menu (index-alist event &optional title)
871 "Let the user select from a buffer index from a mouse menu.
872
873 INDEX-ALIST is the buffer index and EVENT is a mouse event.
874
875 Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."
876 (setq index-alist (imenu--split-submenus index-alist))
877 (let* ((menu (imenu--split-menu index-alist (or title (buffer-name))))
878 (map (imenu--create-keymap (car menu)
879 (cdr (if (< 1 (length (cdr menu)))
880 menu
881 (car (cdr menu)))))))
882 (popup-menu map event)))
883
884 (defun imenu-choose-buffer-index (&optional prompt alist)
885 "Let the user select from a buffer index and return the chosen index.
886
887 If the user originally activated this function with the mouse, a mouse
888 menu is used. Otherwise a completion buffer is used and the user is
889 prompted with PROMPT.
890
891 If you call this function with index alist ALIST, then it lets the user
892 select from ALIST.
893
894 With no index alist ALIST, it calls `imenu--make-index-alist' to
895 create the index alist.
896
897 If `imenu-use-popup-menu' is nil, then the completion buffer
898 is always used, no matter if the mouse was used or not.
899
900 The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
901 (let (index-alist
902 (mouse-triggered (listp last-nonmenu-event))
903 (result t))
904 ;; If selected by mouse, see to that the window where the mouse is
905 ;; really is selected.
906 (and mouse-triggered
907 (not (equal last-nonmenu-event '(menu-bar)))
908 (let ((window (posn-window (event-start last-nonmenu-event))))
909 (or (framep window) (null window) (select-window window))))
910 ;; Create a list for this buffer only when needed.
911 (while (eq result t)
912 (setq index-alist (if alist alist (imenu--make-index-alist)))
913 (setq result
914 (if (and imenu-use-popup-menu
915 (or (eq imenu-use-popup-menu t) mouse-triggered))
916 (imenu--mouse-menu index-alist last-nonmenu-event)
917 (imenu--completion-buffer index-alist prompt)))
918 (and (equal result imenu--rescan-item)
919 (imenu--cleanup)
920 (setq result t imenu--index-alist nil)))
921 result))
922
923 ;;;###autoload
924 (defun imenu-add-to-menubar (name)
925 "Add an `imenu' entry to the menu bar for the current buffer.
926 NAME is a string used to name the menu bar item.
927 See the command `imenu' for more information."
928 (interactive "sImenu menu item name: ")
929 (if (or (and imenu-prev-index-position-function
930 imenu-extract-index-name-function)
931 imenu-generic-expression
932 (not (eq imenu-create-index-function
933 'imenu-default-create-index-function)))
934 (unless (and (current-local-map)
935 (keymapp (lookup-key (current-local-map) [menu-bar index])))
936 (let ((newmap (make-sparse-keymap)))
937 (set-keymap-parent newmap (current-local-map))
938 (setq imenu--last-menubar-index-alist nil)
939 (define-key newmap [menu-bar index]
940 `(menu-item ,name ,(make-sparse-keymap "Imenu")))
941 (use-local-map newmap)
942 (add-hook 'menu-bar-update-hook 'imenu-update-menubar)))
943 (user-error "The mode `%s' does not support Imenu"
944 (format-mode-line mode-name))))
945
946 ;;;###autoload
947 (defun imenu-add-menubar-index ()
948 "Add an Imenu \"Index\" entry on the menu bar for the current buffer.
949
950 A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
951 (interactive)
952 (imenu-add-to-menubar "Index"))
953
954 (defvar imenu-buffer-menubar nil)
955
956 (defvar-local imenu-menubar-modified-tick 0
957 "The value of (buffer-chars-modified-tick) as of the last call
958 to `imenu-update-menubar'.")
959
960 (defun imenu-update-menubar ()
961 (when (and (current-local-map)
962 (keymapp (lookup-key (current-local-map) [menu-bar index]))
963 (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
964 (setq imenu-menubar-modified-tick (buffer-chars-modified-tick))
965 (let ((index-alist (imenu--make-index-alist t)))
966 ;; Don't bother updating if the index-alist has not changed
967 ;; since the last time we did it.
968 (unless (equal index-alist imenu--last-menubar-index-alist)
969 (let (menu menu1 old)
970 (setq imenu--last-menubar-index-alist index-alist)
971 (setq index-alist (imenu--split-submenus index-alist))
972 (setq menu (imenu--split-menu index-alist
973 (buffer-name)))
974 (setq menu1 (imenu--create-keymap (car menu)
975 (cdr (if (< 1 (length (cdr menu)))
976 menu
977 (car (cdr menu))))
978 'imenu--menubar-select))
979 (setq old (lookup-key (current-local-map) [menu-bar index]))
980 ;; This should never happen, but in some odd cases, potentially,
981 ;; lookup-key may return a dynamically composed keymap.
982 (if (keymapp (cadr old)) (setq old (cadr old)))
983 (setcdr old (cdr menu1)))))))
984
985 (defun imenu--menubar-select (item)
986 "Use Imenu to select the function or variable named in this menu ITEM."
987 (if (equal item imenu--rescan-item)
988 (progn
989 (imenu--cleanup)
990 ;; Make sure imenu-update-menubar redoes everything.
991 (setq imenu-menubar-modified-tick -1)
992 (setq imenu--index-alist nil)
993 (setq imenu--last-menubar-index-alist nil)
994 (imenu-update-menubar)
995 t)
996 (imenu item)
997 nil))
998
999 (defun imenu-default-goto-function (_name position &optional _rest)
1000 "Move to the given position.
1001
1002 NAME is ignored. POSITION is where to move. REST is also ignored.
1003 The ignored args just make this function have the same interface as a
1004 function placed in a special index-item."
1005 (if (or (< position (point-min))
1006 (> position (point-max)))
1007 ;; widen if outside narrowing
1008 (widen))
1009 (goto-char position))
1010
1011 ;;;###autoload
1012 (defun imenu (index-item)
1013 "Jump to a place in the buffer chosen using a buffer menu or mouse menu.
1014 INDEX-ITEM specifies the position. See `imenu-choose-buffer-index'
1015 for more information."
1016 (interactive (list (imenu-choose-buffer-index)))
1017 ;; Convert a string to an alist element.
1018 (if (stringp index-item)
1019 (setq index-item (assoc index-item (imenu--make-index-alist))))
1020 (when index-item
1021 (push-mark nil t)
1022 (let* ((is-special-item (listp (cdr index-item)))
1023 (function
1024 (if is-special-item
1025 (nth 2 index-item) imenu-default-goto-function))
1026 (position (if is-special-item
1027 (cadr index-item) (cdr index-item)))
1028 (rest (if is-special-item (cddr index-item))))
1029 (apply function (car index-item) position rest))
1030 (run-hooks 'imenu-after-jump-hook)))
1031
1032 (provide 'imenu)
1033
1034 ;;; imenu.el ends here