comparison lisp/imenu.el @ 41305:71197bcff33c

(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.

41304:eecd5a100096

The variable `imenu-case-fold-search' determines whether or not the
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
`fortran-mode' with `imenu-syntax-alist' set locally to give the
characters which normally have \"symbol\" syntax \"word\" syntax
during matching.")

;;;###autoload

  (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))
		 (if res		; in case, e.g. no functions defined
		     (prog1 (nreverse res) (setcdr res oldlist))))
	       imenu-sort-function)))
    (if (> (length menulist) imenu-max-items)
	(let ((count 0))
	  (setq menulist
		(mapcar

	   ((imenu--subalist-p item)
	    (imenu--cleanup (cdr item)))))
	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--in-alist (str alist)
  "Check whether the string STR is contained in multi-level ALIST."
  (let (elt head tail res)
    (setq res nil)

               (string= str head))
	     (setq alist nil res elt))))
    res))

(defvar imenu-syntax-alist nil
  "Alist of syntax table modifiers to use while executing `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
a string, all the characters in the string get the specified syntax.

;;;

(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
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.")
;;;###autoload
(make-variable-buffer-local 'imenu-case-fold-search)

        (case-fold-search imenu-case-fold-search)
        (old-table (syntax-table))
        (table (copy-syntax-table (syntax-table)))
        (slist imenu-syntax-alist))
    ;; Modify the syntax table used while matching regexps.
    (while 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)))
    (goto-char (point-max))
    (imenu-progress-message prev-pos 0 t)
    (unwind-protect			; for syntax table
	(save-match-data
	  (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)
	  (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))))
    (let ((main-element (assq nil index-alist)))
      (nconc (delq main-element (delq 'dummy index-alist))
	     (cdr main-element)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The main functions for this package!
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun imenu--completion-buffer (index-alist &optional prompt)
  "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.

Returns t for rescan and otherwise a position number."

	  (lambda (item)
	    (cons (subst-char-in-string ?\ (aref imenu-space-replacement 0)
					(car item))
		  (cdr item)))
	  index-alist)))
    (cond (prompt)
	  ((and name (imenu--in-alist name prepared-index-alist))
	   (setq prompt (format "Index item (default %s): " name)))
	  (t (setq prompt "Index item: ")))
    (if (eq imenu-always-use-completion-buffer-p 'never)

	   (all-completions "" prepared-index-alist )))
	(let ((minibuffer-setup-hook
	       (function
		(lambda ()
		  (let ((buffer (current-buffer)))
		    (save-excursion
		      (set-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)
	  (t
	   (setq choice (assoc name prepared-index-alist))
	   (if (imenu--subalist-p choice)
	       (imenu--completion-buffer (cdr choice) prompt)
	     choice)))))

INDEX-ALIST is the buffer index and EVENT is a mouse event.

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))))))))

(defun imenu-choose-buffer-index (&optional prompt alist)
  "Let the user select from a buffer index and return the chosen index.

If the user originally activated this function with the mouse, a mouse

not.

The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
  (let (index-alist
	(mouse-triggered (listp last-nonmenu-event))
	(result t) )
    ;; If selected by mouse, see to that the window where the mouse is
    ;; really is selected.
    (and mouse-triggered
	 (not (equal last-nonmenu-event '(menu-bar)))
	 (let ((window (posn-window (event-start last-nonmenu-event))))

	     (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 index-alist
                                             (buffer-name)))
	       (setq menu1 (imenu--create-keymap-1 (car menu) 
                                                   (if (< 1 (length (cdr menu)))
                                                       (cdr menu)
						     (cdr (car (cdr menu))))
                                                   t))
	       (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."
  (if (equal item imenu--rescan-item)
      (progn
	(imenu--cleanup)
	(setq imenu--index-alist nil)
	(imenu-update-menubar))
    (imenu item)))

(defun imenu-default-goto-function (name position &optional rest)
  "Move the point to the given position.

NAME is ignored.  POSITION is where to move.  REST is also ignored.

for more information."
  (interactive (list (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))))
  (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))

(dolist (mess
	 '("^No items suitable for an index found in this buffer$"
	   "^This buffer cannot use `imenu-default-create-index-function'$"
	   "^The mode `.*' does not support Imenu$"))

41305:71197bcff33c

The variable `imenu-case-fold-search' determines whether or not the
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 `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.")

;;;###autoload

  (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)
    (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
	       (copy-sequence menulist)
	       imenu-sort-function)))
    (if (> (length menulist) imenu-max-items)
	(let ((count 0))
	  (setq menulist
		(mapcar

	   ((imenu--subalist-p item)
	    (imenu--cleanup (cdr item)))))
	alist)
       t))

(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."
  (let (elt head tail res)
    (setq res nil)

               (string= str head))
	     (setq alist nil res elt))))
    res))

(defvar imenu-syntax-alist nil
  "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
a string, all the characters in the string get the specified syntax.

;;;

(defvar imenu-case-fold-search t
  "Defines whether `imenu--generic-function' should fold case when matching.

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.")
;;;###autoload
(make-variable-buffer-local 'imenu-case-fold-search)

        (case-fold-search imenu-case-fold-search)
        (old-table (syntax-table))
        (table (copy-syntax-table (syntax-table)))
        (slist imenu-syntax-alist))
    ;; Modify the syntax table used while matching regexps.
    (dolist (syn slist)
      ;; The character(s) to modify may be a single char or a string.
      (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
	(save-match-data
	  (set-syntax-table table)
	  ;; map over the elements of imenu-generic-expression
	  ;; (typically functions, variables ...)
	  (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.
    (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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The main functions for this package!
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 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.

Returns t for rescan and otherwise a position number."

	  (lambda (item)
	    (cons (subst-char-in-string ?\ (aref imenu-space-replacement 0)
					(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)))
	  (t (setq prompt "Index item: ")))
    (if (eq imenu-always-use-completion-buffer-p 'never)

	   (all-completions "" prepared-index-alist )))
	(let ((minibuffer-setup-hook
	       (function
		(lambda ()
		  (let ((buffer (current-buffer)))
		    (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)
	  (t
	   (setq choice (assoc name prepared-index-alist))
	   (if (imenu--subalist-p choice)
	       (imenu--completion-buffer (cdr choice) prompt)
	     choice)))))

INDEX-ALIST is the buffer index and EVENT is a mouse event.

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))))
	 (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.

If the user originally activated this function with the mouse, a mouse

not.

The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
  (let (index-alist
	(mouse-triggered (listp last-nonmenu-event))
	(result t))
    ;; If selected by mouse, see to that the window where the mouse is
    ;; really is selected.
    (and mouse-triggered
	 (not (equal last-nonmenu-event '(menu-bar)))
	 (let ((window (posn-window (event-start last-nonmenu-event))))

	     (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 index-alist
                                             (buffer-name)))
	       (setq menu1 (imenu--create-keymap-1 (car menu)
                                                   (if (< 1 (length (cdr menu)))
                                                       (cdr menu)
						     (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."
  (if (equal item imenu--rescan-item)
      (progn
	(imenu--cleanup)
	(setq imenu--index-alist nil)
	(imenu-update-menubar)
	t)
    (imenu item)
    nil))

(defun imenu-default-goto-function (name position &optional rest)
  "Move the point to the given position.

NAME is ignored.  POSITION is where to move.  REST is also ignored.

for more information."
  (interactive (list (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))))
  (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$"
	   "^This buffer cannot use `imenu-default-create-index-function'$"
	   "^The mode `.*' does not support Imenu$"))