X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a7acbbe4d48af3113de2dfaf836a42f2a9b6c2b0..7e563e040c12af531a905d4d780535c5c7f7b88b:/lisp/imenu.el diff --git a/lisp/imenu.el b/lisp/imenu.el index 84731d5006..b04aecf3b5 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -1,28 +1,31 @@ ;;; imenu.el --- Framework for mode-specific buffer indexes. -;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Ake Stenhoff ;; Lars Lindberg ;; Created: 8 Feb 1994 ;; Keywords: tools -;; -;; This program is free software; you can redistribute it and/or modify + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify ;; 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. -;; -;; This program is distributed in the hope that it will be useful, + +;; GNU Emacs is distributed in the hope that it will be useful, ;; 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. -;; + ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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. ;;; Commentary: -;; + ;; Purpose of this package: ;; To present a framework for mode-specific buffer indexes. ;; A buffer index is an alist of names and buffer positions. @@ -53,6 +56,7 @@ ;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu ;;; Code + (eval-when-compile (require 'cl)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -60,8 +64,6 @@ ;;; Customizable variables ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar imenu-use-keymap-menu nil - "*Non-nil means use a keymap when making the mouse menu.") (defvar imenu-auto-rescan nil "*Non-nil means Imenu should always rescan the buffers.") @@ -94,7 +96,7 @@ element should come before the second. The arguments are cons cells; \(NAME . POSITION). Look at `imenu--sort-by-name' for an example.") (defvar imenu-max-items 25 - "*Maximum number of elements in an index mouse-menu.") + "*Maximum number of elements in an mouse menu for Imenu.") (defvar imenu-scanning-message "Scanning buffer for index (%3d%%)" "*Progress message during the index scanning of the buffer. @@ -113,9 +115,6 @@ names work as tokens.") Used for making mouse-menu titles and for flattening nested indexes with name concatenation.") -(defvar imenu-submenu-name-format "%s..." - "*The format for making a submenu name.") - ;;;###autoload (defvar imenu-generic-expression nil "The regex pattern to use for creating a buffer index. @@ -123,8 +122,14 @@ with name concatenation.") If non-nil this pattern is passed to `imenu-create-index-with-pattern' to create a buffer index. -It is an alist with elements that look like this: (MENU-TITLE -REGEXP INDEX). +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 +of the form (NAME FUNCTION NAME POSITION-MARKER ARGUMENTS...) +with FUNCTION and ARGUMENTS beiong 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. @@ -145,6 +150,7 @@ For emacs-lisp-mode for example PATTERN would look like: The variable is buffer-local.") +;;;###autoload (make-variable-buffer-local 'imenu-generic-expression) ;;;; Hooks @@ -153,9 +159,13 @@ The variable is buffer-local.") "The function to use for creating a buffer index. It should be a function that takes no arguments and returns an index -of the current buffer as an alist. The elements in the alist look -like: (INDEX-NAME . INDEX-POSITION). You may also nest index list like -\(INDEX-NAME . INDEX-ALIST). +of the current buffer as an alist. + +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 + if it is a sub-alist. This function is called within a `save-excursion'. @@ -181,6 +191,10 @@ This function is called after the function pointed out by `imenu-prev-index-position-function'.") (make-variable-buffer-local 'imenu-extract-index-name-function) +(defun imenu--subalist-p (item) + (and (consp (cdr item)) (listp (cadr item)) + (not (eq (caadr item) 'lambda)))) + ;;; ;;; Macro to display a progress message. ;;; RELPOS is the relative position to display. @@ -278,13 +292,13 @@ This function is called after the function pointed out by index-unknown-alist))))))) (imenu-progress-message prev-pos 100) (and index-var-alist - (push (cons (imenu-create-submenu-name "Variables") index-var-alist) + (push (cons "Variables" index-var-alist) index-alist)) (and index-type-alist - (push (cons (imenu-create-submenu-name "Types") index-type-alist) + (push (cons "Types" index-type-alist) index-alist)) (and index-unknown-alist - (push (cons (imenu-create-submenu-name "Syntax-unknown") index-unknown-alist) + (push (cons "Syntax-unknown" index-unknown-alist) index-alist)) index-alist)) @@ -368,14 +382,6 @@ This function is called after the function pointed out by (/ (1- pos) (max (/ total 100) 1)) (/ (* 100 (1- pos)) (max total 1))))) -;;; -;;; Function for supporting general looking submenu names. -;;; Uses `imenu-submenu-name-format' for creating the name. -;;; NAME is the base of the new submenu name. -;;; -(defun imenu-create-submenu-name (name) - (format imenu-submenu-name-format name)) - ;; 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) @@ -397,25 +403,61 @@ This function is called after the function pointed out by (push (nreverse sublist) result)) (nreverse result))) -;;; -;;; Split a menu in to several menus. -;;; +;;; Split the alist MENULIST into a nested alist, if it is long enough. +;;; In any case, add TITLE to the front of the alist. (defun imenu--split-menu (menulist title) - (cons "Index menu" - (mapcar - (function - (lambda (menu) - (cons (format "(%s)" title) menu))) - (imenu--split menulist imenu-max-items)))) - -;;; -;;; Find all items in this buffer that should be in the index. -;;; Returns an alist on the form -;;; ((NAME . POSITION) (NAME . POSITION) ...) -;;; + (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)) + (prog1 (nreverse res) (setcdr res oldlist))) + 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)))) + +;;; Split up each long alist that are nested within ALIST +;;; into nested alists. +(defun imenu--split-submenus (alist) + (mapcar (function (lambda (elt) + (if (and (consp elt) + (stringp (car elt)) + (listp (cdr elt))) + (imenu--split-menu (cdr elt) (car elt)) + elt))) + alist)) (defun imenu--make-index-alist (&optional noerror) - ;; Create a list for this buffer only when needed. + "Create an index-alist for the definitions in the current buffer. + +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 + if it is a sub-alist. + +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." (or (and imenu--index-alist (or (not imenu-auto-rescan) (and imenu-auto-rescan @@ -430,16 +472,21 @@ This function is called after the function pointed out by (setq imenu--index-alist (list nil))) ;; Add a rescan option to the index. (cons imenu--rescan-item imenu--index-alist)) -;;; + ;;; Find all markers in alist and makes ;;; them point nowhere. -;;; +;;; The top-level call uses nil as the argument; +;;; non-nil arguments are in recursivecalls. +(defvar imenu--cleanup-seen) + (defun imenu--cleanup (&optional alist) - ;; Sets the markers in imenu--index-alist - ;; point nowhere. - ;; if alist is provided use that list. - (or alist - (setq alist imenu--index-alist)) + ;; If alist is provided use that list. + ;; 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))) + (and alist (mapcar (function @@ -447,7 +494,9 @@ This function is called after the function pointed out by (cond ((markerp (cdr item)) (set-marker (cdr item) nil)) - ((consp (cdr item)) + ;; Don't process one alist twice. + ((memq (cdr item) imenu--cleanup-seen)) + ((imenu--subalist-p item) (imenu--cleanup (cdr item)))))) alist) t)) @@ -458,13 +507,14 @@ This function is called after the function pointed out by (function (lambda (item) (cond - ((listp (cdr item)) - (append (list (incf counter) (car item) 'keymap (car item)) + ((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 (list 'lambda 'nil '(interactive) - (list 'imenu--menubar-select item)) - (cons '(nil) t)))) + (let ((end (if commands `(lambda () (interactive) + (imenu--menubar-select ',item)) + (cons '(nil) item)))) (cons (car item) (cons (car item) end)))) ))) @@ -486,11 +536,17 @@ This function is called after the function pointed out by tail (cdr elt) alist (cdr alist) head (car elt)) - (if (string= str head) - (setq alist nil res elt) - (if (and (listp tail) - (setq res (imenu--in-alist str tail))) - (setq alist nil)))) + ;; 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))) + ((string= str head) + (setq alist nil res elt)))) res)) (defun imenu-default-create-index-function () @@ -615,27 +671,32 @@ pattern. (lambda (pat) (let ((menu-title (car pat)) (regexp (cadr pat)) - (index (caddr pat))) - (if (and (not found) ; Only allow one entry; - (looking-at regexp)) - (let ((beg (match-beginning index)) - (end (match-end index))) - (setq found t) - (push - (cons (buffer-substring beg end) beg) - (cdr - (or (if (not (stringp menu-title)) index-alist) - (assoc - (imenu-create-submenu-name menu-title) - index-alist) - (car (push - (cons - (imenu-create-submenu-name menu-title) - '()) - index-alist)))))))))) - patterns)))) - (imenu-progress-message prev-pos 100 t) - (delete 'dummy index-alist))) + (index (caddr pat)) + (function (cadddr pat)) + (rest (cddddr pat))) + (if (and (not found) ; Only allow one entry; + (looking-at regexp)) + (let ((beg (make-marker)) + (end (match-end index))) + (set-marker beg (match-beginning index)) + (setq found t) + (push + (let ((name + (buffer-substring-no-properties beg end))) + (if function + (nconc (list name function name beg) + rest) + (cons name beg))) + (cdr + (or (assoc menu-title index-alist) + (car (push + (cons menu-title '()) + index-alist)))))))))) + patterns)))) + (imenu-progress-message prev-pos 100 t) + (let ((main-element (assq nil index-alist))) + (nconc (delq main-element (delq 'dummy index-alist)) + (cdr main-element))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -681,7 +742,7 @@ Returns t for rescan and otherwise a position number." t) (t (setq choice (assoc name prepared-index-alist)) - (if (listp (cdr choice)) + (if (imenu--subalist-p choice) (imenu--completion-buffer (cdr choice) prompt) choice))))) @@ -690,53 +751,45 @@ Returns t for rescan and otherwise a position number." INDEX-ALIST is the buffer index and EVENT is a mouse event. -Returns t for rescan and otherwise a position number." - (let* ((menu (imenu--split-menu - (if imenu-sort-function - (sort - (let ((res nil) - (oldlist index-alist)) - ;; Copy list method from the cl package `copy-list' - (while (consp oldlist) (push (pop oldlist) res)) - (prog1 (nreverse res) (setcdr res oldlist))) - imenu-sort-function) - index-alist) +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) - (and imenu-use-keymap-menu - (setq menu (imenu--create-keymap-1 (car menu) - (if (< 1 (length (cdr menu))) - (cdr menu) - (cdr (cadr menu)))))) + (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)) - (if imenu-use-keymap-menu - (progn - (cond - ((and (listp position) - (numberp (car position)) - (stringp (nth (1- (length position)) position))) - (setq position (nth (1- (length position)) position))) - ((and (stringp (car position)) - (null (cdr position))) - (setq position (car position)))))) - (cond - ((eq position nil) - position) - ((listp position) - (imenu--mouse-menu position event - (if title - (concat title imenu-level-separator - (car (rassq position index-alist))) - (car (rassq position index-alist))))) - ((stringp position) - (or (string= position (car imenu--rescan-item)) - (imenu--in-alist position index-alist))) - ((or (= position (cdr imenu--rescan-item)) - (and (stringp position) - (string= position (car imenu--rescan-item)))) - t) - (t - (rassq position index-alist))))) + (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)) + (cdr (cdr (cdr 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)))))))) (defun imenu-choose-buffer-index (&optional prompt alist) "Let the user select from a buffer index and return the chosen index. @@ -755,7 +808,7 @@ If `imenu-always-use-completion-buffer-p' is non-nil, then the completion buffer is always used, no matter if the mouse was used or not. -The returned value is on the form (INDEX-NAME . INDEX-POSITION)." +The returned value is of the form (INDEX-NAME . INDEX-POSITION)." (let (index-alist (mouse-triggered (listp last-nonmenu-event)) (result t) ) @@ -780,14 +833,22 @@ The returned value is on the form (INDEX-NAME . INDEX-POSITION)." ;;;###autoload (defun imenu-add-to-menubar (name) - "Adds an \"imenu\" entry to the menu bar for the current major mode. + "Adds an `imenu' entry to the menu bar for the current buffer. NAME is a string used to name the menu bar item. -See `imenu' for more information." +See the command `imenu' for more information." (interactive "sImenu menu item name: ") - (define-key (current-local-map) [menu-bar index] - (cons name (nconc (make-sparse-keymap "Imenu") (make-sparse-keymap)))) + (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)) + (define-key newmap [menu-bar index] + (cons name (nconc (make-sparse-keymap "Imenu") + (make-sparse-keymap)))) + (use-local-map (append newmap (current-local-map)))) (add-hook 'menu-bar-update-hook 'imenu-update-menubar)) +(defvar imenu-buffer-menubar nil) + (defun imenu-update-menubar () (and (current-local-map) (keymapp (lookup-key (current-local-map) [menu-bar index])) @@ -797,16 +858,8 @@ See `imenu' for more information." (or (equal index-alist imenu--last-menubar-index-alist) (let (menu menu1 old) (setq imenu--last-menubar-index-alist index-alist) - (setq menu (imenu--split-menu - (if imenu-sort-function - (sort - (let ((res nil) - (oldlist index-alist)) - ;; Copy list method from the cl package `copy-list' - (while (consp oldlist) (push (pop oldlist) res)) - (prog1 (nreverse res) (setcdr res oldlist))) - imenu-sort-function) - index-alist) + (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) (if (< 1 (length (cdr menu))) @@ -814,13 +867,16 @@ See `imenu' for more information." (cdr (car (cdr menu)))) t)) (setq old (lookup-key (current-local-map) [menu-bar index])) - (if (keymapp old) - (setcdr (nthcdr 2 old) menu1))))))) + (setcdr old (cdr menu1))))))) (defun imenu--menubar-select (item) "Use Imenu to select the function or variable named in this menu item." - (interactive) - (imenu item)) + (if (equal item '("*Rescan*" . -99)) + (progn + (imenu--cleanup) + (setq imenu--index-alist nil) + (imenu-update-menubar)) + (imenu item))) ;;;###autoload (defun imenu (index-item) @@ -829,7 +885,7 @@ See `imenu-choose-buffer-index' for more information." (interactive (list (save-restriction (widen) - (car (imenu-choose-buffer-index))))) + (imenu-choose-buffer-index)))) ;; Convert a string to an alist element. (if (stringp index-item) (setq index-item (assoc index-item (imenu--make-index-alist)))) @@ -838,17 +894,22 @@ See `imenu-choose-buffer-index' for more information." (push-mark) (cond ((markerp (cdr index-item)) - (if (or ( > (marker-position (cdr index-item)) (point-min)) - ( < (marker-position (cdr index-item)) (point-max))) + (if (or (< (marker-position (cdr index-item)) (point-min)) + (> (marker-position (cdr index-item)) (point-max))) ;; widen if outside narrowing (widen)) (goto-char (marker-position (cdr index-item)))) - (t - (if (or ( > (cdr index-item) (point-min)) - ( < (cdr index-item) (point-max))) + ((imenu--subalist-p index-item) + (if (or (< (cdr index-item) (point-min)) + (> (cdr index-item) (point-max))) ;; widen if outside narrowing (widen)) - (goto-char (cdr index-item))))))) + (goto-char (cdr index-item))) + (t + ;; A special item with a function. + (let ((function (cadr index-item)) + (rest (cddr index-item))) + (apply function (car index-item) rest))))))) (provide 'imenu)