-;;; imenu.el --- Framework for mode-specific buffer indexes.
+;;; imenu.el --- framework for mode-specific buffer indexes
;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
;; [christian] - Christian Egli Christian.Egli@hcsd.hac.com
;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu
-;;; Code
+;;; Code:
(eval-when-compile (require 'cl))
(other :tag "Always" t))
:group 'imenu)
+(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)
+
;;;###autoload
(defcustom imenu-sort-function nil
"*The function to use for sorting the index mouse-menu.
(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
-of the form (NAME FUNCTION POSITION-MARKER ARGUMENTS...)
-with FUNCTION and ARGUMENTS beiong copied from `imenu-generic-expression'.
+of the form (NAME POSITION-MARKER FUNCTION ARGUMENTS...)
+with FUNCTION and ARGUMENTS copied from `imenu-generic-expression'.
MENU-TITLE is a string used as the title for the submenu or nil if the
entries are not nested.
The variable is buffer-local.
The variable `imenu-case-fold-search' determines whether or not the
-regexp matches are case sensitive. and `imenu-syntax-alist' can be
+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.")
+For example, see the value of `fortran-imenu-generic-expression' used by
+`fortran-mode' with `imenu-syntax-alist' set locally to give the
+characters which normally have \"symbol\" syntax \"word\" syntax
+during matching.")
;;;###autoload
(make-variable-buffer-local 'imenu-generic-expression)
;;;###autoload
(make-variable-buffer-local 'imenu-extract-index-name-function)
+;;;###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)
+
;;;###autoload
(defvar imenu-default-goto-function 'imenu-default-goto-function
"The default function called when selecting an Imenu item.
(make-variable-buffer-local 'imenu--index-alist)
-;; The latest buffer index used to update the menu bar menu.
-(defvar imenu--last-menubar-index-alist nil)
+(defvar imenu--last-menubar-index-alist nil
+ "The latest buffer index used to update the menu bar menu.")
+
(make-variable-buffer-local 'imenu--last-menubar-index-alist)
;; History list for 'jump-to-function-in-buffer'.
(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)))
+ (dolist (item tail)
+ (if (imenu--subalist-p item)
+ (setq keep-at-top (cons item keep-at-top)
+ menulist (delq item menulist))))
(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))
- (if res ; in case, e.g. no functions defined
- (prog1 (nreverse res) (setcdr res oldlist))))
+ (copy-sequence menulist)
imenu-sort-function)))
(if (> (length menulist) imenu-max-items)
(let ((count 0))
;; 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)))))))
+ (setcar item (substring (car item) 0
+ imenu-max-item-length)))))))
menulist))
(setq alist imenu--index-alist imenu--cleanup-seen (list alist)))
(and alist
- (mapcar
- (function
- (lambda (item)
- (cond
- ((markerp (cdr item))
- (set-marker (cdr item) nil))
- ;; Don't process one alist twice.
- ((memq (cdr item) imenu--cleanup-seen))
- ((imenu--subalist-p item)
- (imenu--cleanup (cdr item))))))
+ (mapc
+ (lambda (item)
+ (cond
+ ((markerp (cdr item))
+ (set-marker (cdr item) nil))
+ ;; Don't process one alist twice.
+ ((memq (cdr item) imenu--cleanup-seen))
+ ((imenu--subalist-p item)
+ (imenu--cleanup (cdr item)))))
alist)
t))
-(defun imenu--create-keymap-2 (alist counter &optional commands)
- (let ((map nil))
- (mapcar
- (function
- (lambda (item)
- (cond
- ((imenu--subalist-p item)
- (append (list (setq counter (1+ counter))
- (car item) 'keymap (car item))
- (imenu--create-keymap-2 (cdr item) (+ counter 10) commands)))
- (t
- (let ((end (if commands `(lambda () (interactive)
- (imenu--menubar-select ',item))
- (cons '(nil) item))))
- (cons (car item)
- (cons (car item) end)))))))
- alist)))
-
-;; 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)))
+(defun imenu--create-keymap-1 (title alist)
+ (let ((counter 0))
+ (list* 'keymap title
+ (mapcar
+ (lambda (item)
+ (list* (car item) (car item)
+ (cond
+ ((imenu--subalist-p item)
+ (imenu--create-keymap-1 (car item) (cdr item)))
+ (t
+ `(lambda () (interactive)
+ (imenu--menubar-select ',item))))))
+ alist))))
(defun imenu--in-alist (str alist)
"Check whether the string STR is contained in multi-level ALIST."
(cond ((listp tail)
(if (setq res (imenu--in-alist str tail))
(setq alist nil)))
- ((string= str head)
+ ((if imenu-name-lookup-function
+ (funcall imenu-name-lookup-function str head)
+ (string= str head))
(setq alist nil res elt))))
res))
(defvar imenu-syntax-alist nil
- "Alist of syntax table modifiers to use while executing `imenu--generic-function'.
+ "Alist of syntax table modifiers to use while in `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
This is typically used to give word syntax to characters which
normally have symbol syntax to simplify `imenu-expression'
and speed-up matching.")
+;;;###autoload
(make-variable-buffer-local 'imenu-syntax-alist)
(defun imenu-default-create-index-function ()
(t
(error "This buffer cannot use `imenu-default-create-index-function'"))))
-(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
- ""))
-
;; 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.
(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
+This 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.")
(table (copy-syntax-table (syntax-table)))
(slist imenu-syntax-alist))
;; Modify the syntax table used while matching regexps.
- (while slist
+ (dolist (syn slist)
;; 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)))
+ (if (numberp (car syn))
+ (modify-syntax-entry (car syn) (cdr syn) table)
+ (dolist (c (car syn))
+ (modify-syntax-entry c (cdr syn) table))))
(goto-char (point-max))
(imenu-progress-message prev-pos 0 t)
(unwind-protect ; for syntax table
(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)))
- ;; 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)))))))))
- patterns)
+ (dolist (pat patterns)
+ (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 (copy-marker beg)))
+ (let ((item
+ (if function
+ (nconc (list (match-string-no-properties index)
+ beg function)
+ rest)
+ (cons (match-string-no-properties index)
+ beg)))
+ ;; 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))))))))
(set-syntax-table old-table)))
(imenu-progress-message prev-pos 100 t)
;; 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))))
+ (dolist (item index-alist)
+ (when (listp item)
+ (setcdr item (sort (cdr item) 'imenu--sort-by-position))))
(let ((main-element (assq nil index-alist)))
(nconc (delq main-element (delq 'dummy index-alist))
(cdr main-element)))))
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; See also info-lookup-find-item
+(defun imenu-find-default (guess completions)
+ "Fuzzily find an item based on GUESS inside the alist COMPLETIONS."
+ (catch 'found
+ (let ((case-fold-search t))
+ (if (assoc guess completions) guess
+ (dolist (re (list (concat "\\`" (regexp-quote guess) "\\'")
+ (concat "\\`" (regexp-quote guess))
+ (concat (regexp-quote guess) "\\'")
+ (regexp-quote guess)))
+ (dolist (x completions)
+ (if (string-match re (car x)) (throw 'found (car x)))))))))
+
(defun imenu--completion-buffer (index-alist &optional prompt)
"Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
choice
(prepared-index-alist
(mapcar
- (function
- (lambda (item)
- (cons (imenu--replace-spaces (car item) imenu-space-replacement)
- (cdr item))))
+ (lambda (item)
+ (cons (subst-char-in-string ?\ (aref imenu-space-replacement 0)
+ (car item))
+ (cdr item)))
index-alist)))
+ (when (stringp name)
+ (setq name (or (imenu-find-default name prepared-index-alist) name)))
(cond (prompt)
((and name (imenu--in-alist name prepared-index-alist))
(setq prompt (format "Index item (default %s): " name)))
(function
(lambda ()
(let ((buffer (current-buffer)))
- (save-excursion
- (set-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(setq completion-reference-buffer buffer)))))))
;; Make a completion question
(setq name (completing-read prompt
prepared-index-alist
nil t nil 'imenu--history-list name)))))
- (cond ((not (stringp name))
- nil)
- ((string= name (car imenu--rescan-item))
- t)
+ (cond ((not (stringp name)) nil)
+ ((string= name (car imenu--rescan-item)) t)
(t
(setq choice (assoc name prepared-index-alist))
(if (imenu--subalist-p choice)
Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."
(setq index-alist (imenu--split-submenus index-alist))
- (let* ((menu (imenu--split-menu index-alist
- (or title (buffer-name))))
- position)
- (setq menu (imenu--create-keymap-1 (car menu)
- (if (< 1 (length (cdr menu)))
- (cdr menu)
- (cdr (car (cdr menu))))))
- (setq position (x-popup-menu event menu))
- (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)
- (numberp (car position))
- (stringp (nth (1- (length position)) position)))
- (let ((final menu))
- (while position
- (setq final (assoc (car position) final))
- (setq position (cdr position)))
- (or (string= (car final) (car imenu--rescan-item))
- (nthcdr 3 final))))
- ;; 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))
- (null (cdr position)))
- (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.
- ((listp position)
- (imenu--mouse-menu position event
- (if title
- (concat title imenu-level-separator
- (car (rassq position index-alist)))
- (car (rassq position index-alist))))))))
+ (let* ((menu (imenu--split-menu index-alist (or title (buffer-name))))
+ (map (imenu--create-keymap-1 (car menu)
+ (if (< 1 (length (cdr menu)))
+ (cdr menu)
+ (cdr (car (cdr menu)))))))
+ (popup-menu map event)))
(defun imenu-choose-buffer-index (&optional prompt alist)
"Let the user select from a buffer index and return the chosen index.
The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
(let (index-alist
(mouse-triggered (listp last-nonmenu-event))
- (result t) )
+ (result t))
;; If selected by mouse, see to that the window where the mouse is
;; really is selected.
(and mouse-triggered
imenu-generic-expression
(not (eq imenu-create-index-function
'imenu-default-create-index-function)))
- (let ((newmap (make-sparse-keymap))
- (menu-bar (lookup-key (current-local-map) [menu-bar])))
- (define-key newmap [menu-bar]
- (append (make-sparse-keymap) menu-bar))
+ (let ((newmap (make-sparse-keymap)))
+ (set-keymap-parent newmap (current-local-map))
+ (setq imenu--last-menubar-index-alist nil)
(define-key newmap [menu-bar index]
- (cons name (nconc (make-sparse-keymap "Imenu")
- (make-sparse-keymap))))
- (use-local-map (append newmap (current-local-map)))
+ `(menu-item ,name ,(make-sparse-keymap "Imenu")))
+ (use-local-map newmap)
(add-hook 'menu-bar-update-hook 'imenu-update-menubar))
(error "The mode `%s' does not support Imenu" mode-name)))
(setq index-alist (imenu--split-submenus index-alist))
(setq menu (imenu--split-menu index-alist
(buffer-name)))
- (setq menu1 (imenu--create-keymap-1 (car menu)
+ (setq menu1 (imenu--create-keymap-1 (car menu)
(if (< 1 (length (cdr menu)))
(cdr menu)
- (cdr (car (cdr menu))))
- t))
+ (cdr (car (cdr menu))))))
(setq old (lookup-key (current-local-map) [menu-bar index]))
(setcdr old (cdr menu1)))))))
(defun imenu--menubar-select (item)
- "Use Imenu to select the function or variable named in this menu item."
+ "Use Imenu to select the function or variable named in this menu ITEM."
(if (equal item imenu--rescan-item)
(progn
(imenu--cleanup)
(setq imenu--index-alist nil)
- (imenu-update-menubar))
- (imenu item)))
+ (imenu-update-menubar)
+ t)
+ (imenu item)
+ nil))
(defun imenu-default-goto-function (name position &optional rest)
"Move the point to the given position.
;; Convert a string to an alist element.
(if (stringp index-item)
(setq index-item (assoc index-item (imenu--make-index-alist))))
- (and index-item
- (progn
- (push-mark)
- (let* ((is-special-item (listp (cdr index-item)))
- (function
- (if is-special-item
- (nth 2 index-item) imenu-default-goto-function))
- (position (if is-special-item
- (cadr index-item) (cdr index-item)))
- (rest (if is-special-item (cddr index-item))))
- (apply function (car index-item) position rest)))))
+ (when index-item
+ (push-mark)
+ (let* ((is-special-item (listp (cdr index-item)))
+ (function
+ (if is-special-item
+ (nth 2 index-item) imenu-default-goto-function))
+ (position (if is-special-item
+ (cadr index-item) (cdr index-item)))
+ (rest (if is-special-item (cddr index-item))))
+ (apply function (car index-item) position rest))
+ (run-hooks 'imenu-after-jump-hook)))
+
+(dolist (mess
+ '("^No items suitable for an index found in this buffer$"
+ "^This buffer cannot use `imenu-default-create-index-function'$"
+ "^The mode `.*' does not support Imenu$"))
+ (add-to-list 'debug-ignored-errors mess))
(provide 'imenu)
HCoop / bpt / emacs.git / blobdiff