Download
(eval-when-compile (require 'cl))
(require 'imenu)
(defvar imenu-menubar-modified-tick)
(defgroup Imenu-Plus nil
"Various enhancements to Imenu."
:prefix "imenup-"
:group 'imenu
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
imenu+.el bug: \
&body=Describe bug here, starting with `emacs -q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Other Libraries by Drew"
"http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
:link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/imenu+.el")
:link '(url-link :tag "Description" "http://www.emacswiki.org/ImenuMode#ImenuPlus")
:link '(emacs-commentary-link :tag "Commentary" "imenu+"))
(defcustom imenup-sort-ignores-case nil
"*Non-nil means that `imenu--sort-by-name' sorts case-insensitively."
:type 'boolean :group 'Imenu-Plus)
(defconst imenu-sort-function 'imenu--sort-by-name)
(defvar imenup-last-sort-function `imenu--sort-by-name
"The last non-nil value for `imenu-sort-function' during this session.")
(defvar imenup-emacs-key-defn-regexp-1 "(\\s-*\\(\\(global\\|local\\)-\\(un\\)?\
set-key\\|undefine-keys-bound-to\\)\\s-*\\((kbd\\s-*\\)?\\(\"[^\"]+\"\\|[[][^]]+[]]\\)"
"*Regexp that recognizes Emacs key definitions.
See also `imenup-emacs-key-defn-regexp-2'.")
(defvar imenup-emacs-key-defn-regexp-2 "(\\s-*\\(define-key\\(-after\\)?\\s-+\
\\|substitute-key-definition\\s-+'\\)\\(\\S-+\\)\\s-*'?\\((kbd\\s-*\\)?\\(\"[^\"]+\"\\|[[][^]]+[]]\\)"
"*Regexp that recognizes Emacs key definitions.
See also `imenup-emacs-key-defn-regexp-1'.")
(defvar imenup-lisp-other-defn-regexp
(if (>= emacs-major-version 22)
(concat "^\\s-*("
(regexp-opt '("defgroup" "deftheme" "deftype" "defstruct"
"defclass" "define-condition" "define-widget"
"defpackage") t)
"\\s-+'?\\(\\sw\\(\\sw\\|\\s_\\)+\\)")
"(\\s-*def\\(type\\|class\\|ine-condition\\)\\s-+'?\\([^ \t()]+\\)")
"*Regexp that recognizes other Lisp definitions.")
(defvar imenup-lisp-fn-defn-regexp
(if (>= emacs-major-version 22)
(concat "^\\s-*("
(regexp-opt '("defun" "defun*" "defsubst" "defadvice"
"define-skeleton" "define-minor-mode"
"define-global-minor-mode" "define-globalized-minor-mode"
"define-derived-mode" "define-generic-mode" "defsetf"
"define-setf-expander" "define-method-combination"
"defgeneric" "defmethod" "icicle-define-command"
"icicle-define-file-command") t)
"\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)")
(concat "^\\s-*("
(regexp-opt
'("defun" "defun*" "defsubst" "defadvice" "define-skeleton"
"define-derived-mode" "defsetf" "icicle-define-add-to-alist-command"
"icicle-define-command" "icicle-define-file-command") t)
"\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)"))
"*Regexp that recognizes Lisp function definitions.")
(defvar imenup-lisp-macro-defn-regexp
"(\\s-*\\(defmacro\\|define-compiler-macro\\|define-modify-macro\\)\\s-+\\([^ \t()]+\\)"
"*Regexp that recognizes Lisp macro definitions.")
(defvar imenup-emacs-face-defn-regexp "(\\s-*\\(defface\\)\\s-+\\([^ \t()]+\\)"
"*Regexp for Emacs face definitions (defface).")
(defvar imenup-emacs-option-defn-regexp "(\\s-*\\(defcustom\\)\\s-+\\([^ \t()]+\\)"
"*Regexp for Emacs user option definitions (defcustom).")
(defvar imenup-lisp-var-defn-regexp
(if (>= emacs-major-version 22)
(concat "^\\s-*("
(regexp-opt '("defvar" "defconst" "defconstant" "defcustom"
"defparameter" "define-symbol-macro") t)
"\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)"
"\\(\\s-\\|[\n]\\)+"
"[^) \t\n]")
"(\\s-*def\\(var\\|const\\)\\s-+\\([^ \t()]+\\)")
"*Regexp that recognizes global Lisp variable definitions.")
(defconst lisp-imenu-generic-expression
(list
(list "Other" imenup-lisp-other-defn-regexp 2)
(list "Macros" imenup-lisp-macro-defn-regexp 2)
(list "Functions" imenup-lisp-fn-defn-regexp (if (string-match "\\(?:\\)" "") 2 6))
(list "Variables" imenup-lisp-var-defn-regexp 2)
)
"*Imenu generic expression for Lisp mode.
See `imenu-generic-expression'.")
(defvar imenup-emacs-lisp-generic-expression
(list
(list "Other" imenup-lisp-other-defn-regexp 2)
(list "Keys in Maps" imenup-emacs-key-defn-regexp-2 5)
(list "Keys" imenup-emacs-key-defn-regexp-1 5)
(list "Macros" imenup-lisp-macro-defn-regexp 2)
(list "Functions" imenup-lisp-fn-defn-regexp (if (string-match "\\(?:\\)" "") 2 6))
(list "Variables" imenup-lisp-var-defn-regexp 2)
(list "User Options" imenup-emacs-option-defn-regexp 2)
(list "Faces" imenup-emacs-face-defn-regexp 2)
)
"*Imenu generic expression for Emacs Lisp mode.
See `imenu-generic-expression'.")
(add-hook 'lisp-mode-hook
(lambda ()
(setq imenu-generic-expression lisp-imenu-generic-expression)
(condition-case nil (imenup-add-defs-to-menubar) (error nil))))
(add-hook 'emacs-lisp-mode-hook
(lambda ()
(setq imenu-generic-expression imenup-emacs-lisp-generic-expression)
(condition-case nil (imenup-add-defs-to-menubar) (error nil))))
(defun imenup-toggle-sort (&optional arg)
"Toggle imenu between sorting menus and not.
With a prefix ARG, turn on if ARG is non-negative, off if negative.
See also command `imenup-toggle-case-sensitive-sorting'."
(interactive "P")
(if arg
(setq imenu-sort-function (and (wholenump (prefix-numeric-value arg))
imenup-last-sort-function))
(if imenu-sort-function
(setq imenup-last-sort-function imenu-sort-function
imenu-sort-function nil)
(setq imenu-sort-function imenup-last-sort-function)))
(imenu--menubar-select imenu--rescan-item)
(case imenu-sort-function
(imenu--sort-by-name (message "Menu items now being sorted by name"))
((nil) (message "Menu items are in buffer order (NOT SORTED)"))
(otherwise (message "Menu items now being sorted with `%s'" imenu-sort-function))))
(defun imenup-toggle-case-sensitive-sorting ()
"Toggle option `imenup-sort-ignores-case'.
This affects menu sorting using `imenu--sort-by-name'."
(interactive)
(setq imenup-sort-ignores-case (not imenup-sort-ignores-case))
(imenu--menubar-select imenu--rescan-item)
(if (eq 'imenu--sort-by-name imenu-sort-function)
(message "Sorting menu items by name %s" (if imenup-sort-ignores-case
"now ignores case"
"is now case SENSITIVE"))
(message "NOT sorting by name now, but will %s if you do" (if imenup-sort-ignores-case
"IGNORE case"
"RESPECT case"))))
(defun imenu--sort-by-name (item1 item2)
"Return non-nil if ITEM1 comes before ITEM2 alphabetically.
The arguments are menu items, which have form (NAME . POSITION).
Their NAMEs are compared.
Comparison is case-sensitive if `imenup-sort-ignores-case' is
non-nil. You can toggle that option using `\\[imenup-toggle-sort]'."
(let ((name1 (car item1))
(name2 (car item2)))
(when imenup-sort-ignores-case (setq name1 (upcase name1)
name2 (upcase name2)))
(string-lessp name1 name2)))
(defun imenup-add-defs-to-menubar ()
"Add \"Defs\" imenu entry to menu bar for current local keymap.
See `imenu' for more information."
(interactive)
(imenu-add-to-menubar "Defs"))
(defun imenup--sort-submenu (submenu predicate)
"Create an imenu SUBMENU, sorting with PREDICATE."
(let ((menu-name (car submenu))
(menu-items (cdr submenu)))
(cons menu-name (if (imenu--subalist-p submenu)
(sort (copy-sequence menu-items) predicate)
menu-items))))
(defun imenu--split-submenus (alist)
"Split up each long alist that are nested within ALIST into nested alists.
Return a split and sorted copy of ALIST. The returned alist DOES
NOT share structure with ALIST."
(mapcar (lambda (elt)
(if (imenu--subalist-p elt)
(imenu--split-menu (cdr elt) (car elt))
elt))
alist))
(defun imenu-update-menubar ()
"Update the Imenu menu. Use as `menu-bar-update-hook'."
(when (and (current-local-map)
(keymapp (lookup-key (current-local-map) [menu-bar index]))
(or (not (boundp 'imenu-menubar-modified-tick))
(/= (buffer-chars-modified-tick) imenu-menubar-modified-tick)))
(when (boundp 'imenu-menubar-modified-tick)
(setq imenu-menubar-modified-tick (buffer-chars-modified-tick)))
(let ((index-alist (imenu--make-index-alist t)))
(unless (equal index-alist imenu--last-menubar-index-alist)
(let (menu menu1 old)
(setq imenu--last-menubar-index-alist index-alist
index-alist (imenu--split-submenus
(if imenu-sort-function
(mapcar (lambda (sm)
(imenup--sort-submenu
sm imenu-sort-function))
index-alist)
index-alist))
menu (imenu--split-menu index-alist (buffer-name)))
(if (>= emacs-major-version 22)
(setq menu1 (imenu--create-keymap (car menu)
(cdr (if (< 1 (length (cdr menu)))
menu
(car (cdr menu))))
'imenu--menubar-select))
(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]))
(when (keymapp (cadr old)) (setq old (cadr old)))
(setcdr old (cdr menu1)))))))
(eval-and-compile
(when (< emacs-major-version 22)
(defmacro imenu-progress-message (prevpos &optional relpos reverse) )))
(defun imenu--make-index-alist (&optional noerror)
"Create an index alist for the definitions in the current buffer.
This works by using the hook function `imenu-create-index-function'.
Report an error if the list is empty unless NOERROR is supplied and
non-nil.
If `ignore-comments-flag' is defined and non-nil, then respect it,
ignoring hidden comments.
See `imenu--index-alist' for the format of the index alist."
(or (and imenu--index-alist
(or (not imenu-auto-rescan)
(and imenu-auto-rescan (> (buffer-size) imenu-auto-rescan-maxout))))
(progn (setq imenu--index-alist (save-excursion
(save-restriction
(widen)
(if (and (> emacs-major-version 20)
(require 'hide-comnt nil t))
(let ((search-invisible nil))
(with-comments-hidden
(point-min) (point-max)
(funcall imenu-create-index-function)))
(funcall imenu-create-index-function)))))
(imenu--truncate-items imenu--index-alist)))
(or imenu--index-alist noerror
(if (fboundp 'user-error)
(user-error "No items suitable for an index found in this buffer")
(error "No items suitable for an index found in this buffer")))
(or imenu--index-alist (setq imenu--index-alist (list nil)))
(cons imenu--rescan-item
(cons '("Toggle Case-Sensitive Name-Sort" IGNORE
(lambda (&rest _ignore) (imenup-toggle-case-sensitive-sorting)))
(cons '("Toggle Sorting" IGNORE (lambda (&rest _ignore) (imenup-toggle-sort)))
imenu--index-alist))))
(defun imenup-invisible-p (position)
"Return non-nil if the character at POSITION is invisible."
(if (fboundp 'invisible-p)
(invisible-p position)
(let ((prop (get-char-property position 'invisible)))
(if (eq buffer-invisibility-spec t)
prop
(or (memq prop buffer-invisibility-spec) (assq prop buffer-invisibility-spec))))))
(defun imenu--generic-function (patterns)
"Return an index alist of the current buffer based on PATTERNS.
PATTERNS is 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 (INDEX-NAME POSITION-MARKER FUNCTION
ARGUMENTS...) with FUNCTION and ARGUMENTS copied from PATTERNS.
MENU-TITLE is a string used as the title for the submenu or nil if the
entries are not nested.
REGEXP is a regexp that should match a construct in the buffer that is
to be displayed in the menu; i.e., function or variable definitions,
etc. It contains a substring which is the name to appear in the menu.
See the info section on Regexps for more information. REGEXP may also
be a function, called without arguments. It is expected to search
backwards. It shall return true and set `match-data' if it finds
another element.
INDEX points to the substring in REGEXP that contains the name (of the
function, variable or type) that is to appear in the menu.
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.
See `lisp-imenu-generic-expression' for an example of PATTERNS.
Returns an index of the current buffer as an alist. The elements in
the alist look like:
(INDEX-NAME . INDEX-POSITION)
or like:
(INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...)
They may also be nested index alists like:
(INDEX-NAME . INDEX-ALIST)
depending on PATTERNS."
(let ((index-alist (list 'dummy))
(case-fold-search (if (or (local-variable-p 'imenu-case-fold-search)
(not (local-variable-p 'font-lock-defaults)))
imenu-case-fold-search
(nth 2 font-lock-defaults)))
(old-table (syntax-table))
(table (copy-syntax-table (syntax-table)))
(slist imenu-syntax-alist)
prev-pos)
(dolist (syn slist)
(if (numberp (car syn))
(modify-syntax-entry (car syn) (cdr syn) table)
(mapc (lambda (c) (modify-syntax-entry c (cdr syn) table)) (car syn))))
(goto-char (point-max))
(imenu-progress-message prev-pos 0 t)
(unwind-protect
(save-match-data
(set-syntax-table table)
(dolist (pat patterns)
(let ((menu-title (car pat))
(regexp (nth 1 pat))
(index (nth 2 pat))
(function (nth 3 pat))
(rest (nthcdr 4 pat))
start beg)
(goto-char (point-max))
(while (and (if (functionp regexp)
(funcall regexp)
(and (re-search-backward regexp nil t)
(let ((invis (imenup-invisible-p (point))))
(or (not invis)
(progn
(while (and invis (not (bobp)))
(setq invis (not (re-search-backward regexp nil 'MOVE))))
(not invis))))))
(not (= (match-beginning 0) (match-end 0))))
(setq start (point))
(goto-char (match-beginning index))
(beginning-of-line)
(setq beg (point))
(imenu-progress-message prev-pos nil t)
(unless (assoc menu-title index-alist) (push (list menu-title) index-alist))
(when 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)))
(menu (assoc menu-title index-alist)))
(unless (member item (cdr menu)) (setcdr menu (cons item (cdr menu)))))
(goto-char start))))
(set-syntax-table old-table)))
(imenu-progress-message prev-pos 100 t)
(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)))))
(defun imenu--mouse-menu (index-alist event &optional title)
"Let the user select from a buffer index from a mouse menu.
INDEX-ALIST is the buffer index.
EVENT is a mouse event.
TITLE is the menu title.
Returns t for rescan, or else an element or subelement of INDEX-ALIST."
(setq index-alist (imenu--split-submenus
(if imenu-sort-function
(mapcar (lambda (sm) (imenup--sort-submenu sm imenu-sort-function))
index-alist)
index-alist)))
(if (>= emacs-major-version 22)
(let* ((menu (imenu--split-menu index-alist (or title (buffer-name))))
(map (imenu--create-keymap (car menu)
(cdr (if (< 1 (length (cdr menu)))
menu
(car (cdr menu)))))))
(popup-menu map event))
(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))))
position (x-popup-menu event menu))
(cond ((eq position nil)
position)
((and (listp position) (numberp (car position)) (stringp (nth (1- (length position))
position)))
(let ((final menu))
(while position
(setq final (assq (car position) final)
position (cdr position)))
(or (string= (car final) (car imenu--rescan-item)) (nthcdr 3 final))))
((and (consp position) (stringp (car position)) (null (cdr position)))
(or (string= (car position) (car imenu--rescan-item))
(assq (car position) index-alist)))
((listp position)
(imenu--mouse-menu position event (if title
(concat title imenu-level-separator
(car (rassq position index-alist)))
(car (rassq position index-alist)))))))))
(provide 'imenu+)