(imenu--make-index-alist): Add doc string.
[bpt/emacs.git] / lisp / imenu.el
index a8d9d15..b04aecf 100644 (file)
@@ -64,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.")
@@ -124,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.
@@ -146,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
@@ -154,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'.
 
@@ -182,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.
@@ -393,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.
@@ -415,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
@@ -437,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
@@ -454,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))
@@ -465,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))))
         )))
@@ -494,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 ()
@@ -623,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)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -685,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)))))
 
@@ -694,54 +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)
-    (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.
@@ -760,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) )
@@ -811,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)))
@@ -828,8 +867,7 @@ See the command `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."
@@ -847,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))))
@@ -856,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)