(imenu--generic-function): Create a special entry

if the element of imenu-generic-function asks for it.
(imenu): Handle special entries.
(imenu--submenu-p): New function.  Use in various places.

1 files changed, 50 insertions, 24 deletions

diff --git a/lisp/imenu.el b/lisp/imenu.el
index 876f6f2f061..6cefcfdfdb4 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -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.
@@ -462,7 +476,7 @@ This function is called after the function pointed out by
            (cond
             ((markerp (cdr item))
              (set-marker (cdr item) nil))
-            ((consp (cdr item))
+            ((imenu--subalist-p item)
              (imenu--cleanup (cdr item))))))
         alist)
        t))
@@ -473,7 +487,7 @@ 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)))
@@ -637,20 +651,27 @@ 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 (make-marker))
-                              (end (match-end index)))
-                          (set-marker beg (match-beginning 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)))
@@ -700,7 +721,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)))))
 
@@ -857,12 +878,17 @@ See `imenu-choose-buffer-index' for more information."
                ;; widen if outside narrowing
                (widen))
            (goto-char (marker-position (cdr index-item))))
-          (t
+          ((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)