(imenu--make-index-alist): Add doc string.
[bpt/emacs.git] / lisp / imenu.el
index bc9e866..b04aecf 100644 (file)
@@ -122,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.
@@ -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.
@@ -392,16 +406,35 @@ This function is called after the function pointed out by
 ;;; 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)
-  (if (> (length menulist) imenu-max-items)
-      (let ((count 0))
-       (cons title
-             (mapcar
-              (function
-               (lambda (menu)
-                 (cons (format "(%s-%d)" title (setq count (1+ count)))
-                       menu)))
-              (imenu--split menulist imenu-max-items))))
-    (cons title menulist)))
+  (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.
@@ -414,14 +447,17 @@ This function is called after the function pointed out by
                        elt)))
          alist))
 
-;;;
-;;; Find all items in this buffer that should be in the index.
-;;; Returns an alist on the form
-;;; ((NAME . POSITION) (NAME . POSITION) ...)
-;;;
-
 (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
@@ -436,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
@@ -453,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))
@@ -464,14 +507,14 @@ This function is called after the function pointed out by
      (function
       (lambda (item)
        (cond
-        ((listp (cdr 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 `(lambda () (interactive)
                                     (imenu--menubar-select ',item))
-                      (cons '(nil) t))))
+                      (cons '(nil) item))))
            (cons (car item)
                  (cons (car item) end))))
         )))
@@ -493,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 ()
@@ -622,23 +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-no-properties beg end) beg)
-                          (cdr 
-                           (or (assoc menu-title index-alist)
-                               (car (push 
-                                     (cons menu-title '()) 
-                                     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)) main-element))))
+      (nconc (delq main-element (delq 'dummy index-alist))
+            (cdr main-element)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -684,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)))))
 
@@ -693,49 +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."
+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
-                (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)
+  (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 (cadr menu)))))
+                                        (cdr (car (cdr menu))))))
     (setq position (x-popup-menu event menu))
-    (cond ((and (listp position)
+    (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)))
-          (setq position (nth (1- (length position)) position)))
-         ((and (stringp (car 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)))
-          (setq position (car position))))
-    (cond ((eq position nil)
-          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)))))
-         ((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)))))
+                               (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.
@@ -754,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) )
@@ -805,16 +859,7 @@ See the command `imenu' for more information."
             (let (menu menu1 old)
               (setq imenu--last-menubar-index-alist index-alist)
               (setq index-alist (imenu--split-submenus 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 menu (imenu--split-menu index-alist
                           (buffer-name)))
               (setq menu1 (imenu--create-keymap-1 (car menu) 
                                                   (if (< 1 (length (cdr menu)))
@@ -849,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)