# HG changeset patch # User Stefan Monnier # Date 1006215435 0 # Node ID 71197bcff33c7fb3dff7b6d3a85ea927e62abdcb # Parent eecd5a1000965fbc40344baa5d11a315e5213a84 (imenu--split-menu): Use dolist and copy-sequence. (imenu--create-keymap-2): Remove. (imenu--create-keymap-1): Simplify, remove third argument. (imenu--generic-function): Use dolist. (imenu-find-default): New function. (imenu--completion-buffer): Use it. (imenu--mouse-menu): Use popup-menu. (imenu--menubar-select): Return t rather than calling imenu. diff -r eecd5a100096 -r 71197bcff33c lisp/imenu.el --- a/lisp/imenu.el Tue Nov 20 00:09:00 2001 +0000 +++ b/lisp/imenu.el Tue Nov 20 00:17:15 2001 +0000 @@ -207,7 +207,7 @@ 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 +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.") @@ -517,20 +517,14 @@ (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)) @@ -631,35 +625,19 @@ alist) t)) -(defun imenu--create-keymap-2 (alist counter &optional commands) - (let ((map nil)) - (mapcar - (lambda (item) - (cond - ((imenu--subalist-p item) - (nconc (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) - ;; Fixme: Using this (to speded up menus), instead of - ;; the line above, breaks the case where `imenu' is - ;; bound to a mouse key. The code in imenu needs - ;; fixing somehow to cope. - ;; (list 'menu-item (car item) end :key-sequence nil) - ))))) - 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) - (cons 'keymap (cons 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." @@ -686,7 +664,7 @@ 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 @@ -757,7 +735,7 @@ (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.") @@ -797,14 +775,12 @@ (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) - (mapc (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 @@ -812,49 +788,44 @@ (set-syntax-table table) ;; map over the elements of imenu-generic-expression ;; (typically functions, variables ...) - (mapc - (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 (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)))))))) - 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))))) @@ -865,6 +836,19 @@ ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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. @@ -879,6 +863,8 @@ (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))) @@ -896,17 +882,14 @@ (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) @@ -920,43 +903,12 @@ 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 (assq (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. @@ -978,7 +930,7 @@ 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 @@ -1040,22 +992,23 @@ (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. @@ -1078,20 +1031,17 @@ ;; 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) - ;; Fixme: sort this out so that we can use menu-item with - ;; :key-sequence in imenu--create-keymap-2. - (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)) + (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$"