imenu+.el - extensions to GNU `imenu.el'

[Drew Adams]

;;; imenu+.el --- Extensions to `imenu.el'.
;; 
;; Emacs Lisp Archive Entry
;; Filename: imenu+.el
;; Description: Extensions to `imenu.el'.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1999-2001, Drew Adams, all rights reserved.
;; Created: Thu Aug 26 16:05:01 1999
;; Version: $Id: imenu+.el,v 1.6 2001/01/08 23:20:31 dadams Exp $
;; Last-Updated: Mon Jan  8 15:20:25 2001
;;           By: dadams
;;     Update #: 326
;; Keywords: tools
;; Compatibility: GNU Emacs 20.x
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Commentary: 
;; 
;; Extensions to `imenu.el'.
;;
;;   New functions defined here:
;;
;;    `imenu-add-defs-to-menubar', `imenu--sort-submenu',
;;    `toggle-imenu-sort'.
;;
;;   New user options (variables) defined here:
;;
;;    `emacs-lisp-imenu-generic-expression',
;;    `imenu-emacs-key-defn-regexp-1',
;;    `imenu-emacs-key-defn-regexp-2', `imenu-lisp-fn-defn-regexp',
;;    `imenu-lisp-macro-defn-regexp', `imenu-lisp-struct-defn-regexp',
;;    `imenu-lisp-type-defn-regexp', `imenu-lisp-var-defn-regexp',
;;    `imenu-sort-function'.
;;
;;   Other variables defined here:
;;
;;    `imenu-last-sort-function'.
;;
;;
;;  ***** NOTE: The following functions defined in `imenu.el' have
;;              been REDEFINED HERE:
;;
;;  `imenu-update-menubar', `imenu--mouse-menu'.
;;
;;
;;  ***** NOTE: The following variable defined in `imenu.el' has
;;              been REDEFINED HERE:
;;
;;  `imenu-sort-function'.
;;
;;  ***** NOTE: The following variable defined in `lisp-mode.el' has
;;              been REDEFINED HERE:
;;
;;  `lisp-imenu-generic-expression'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Change log:
;; 
;; RCS $Log: imenu+.el,v $
;; RCS Revision 1.6  2001/01/08 23:20:31  dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.5  2001/01/05 18:05:45  dadams
;; RCS Unquoted mapcar lambda args.
;; RCS
;; RCS Revision 1.4  2001/01/03 23:29:46  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3  2001/01/03 17:38:21  dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.2  2000/11/01 15:42:33  dadams
;; RCS Put imenu-add-defs-to-menubar inside condition-case, in 
(*-)lisp-mode-hooks
;; RCS
;; RCS Revision 1.1  2000/09/14 17:20:34  dadams
;; RCS Initial revision
;; RCS
; Revision 1.7  1999/09/03  08:18:00  dadams
; Added ;;;###autoloads for regexp strings.
;
; Revision 1.6  1999/09/03  08:09:03  dadams
; 1. Require imenu-.el.
; 2. emacs-lisp-imenu-generic-expression: added ;;;###autoload.
; 3. Removed imenu-sort-function to imenu-.el & changed to defvar.
; 4. Moved provide to end.
;
; Revision 1.5  1999/08/30  08:54:33  dadams
; 1. imenu-emacs-key-defn-regexp-2: Added define-key-after.
; 2. Updated  emacs-lisp-imenu-generic-expression (Keys in Maps).
;
; Revision 1.4  1999/08/27  14:56:45  dadams
; defconst -> defvar: *-regexp*, emacs-lisp-imenu-generic-expression.
;
; Revision 1.3  1999/08/27  14:50:57  dadams
; Corrected: imenu-lisp-fn-defn-regexp, imenu-lisp-macro-defn-regexp,
;            imenu-lisp-var-defn-regexp, imenu--sort-submenu.
;
; Revision 1.2  1999/08/27  14:31:41  dadams
; 1. Added: imenu--sort-submenu, imenu-update-menubar, imenu--mouse-menu.
;    Redefinition of originals: imenu-update-menubar, imenu--mouse-menu.
; 2. Corrected: imenu-emacs-key-defn-regexp-2.
; 3. Uncommented assignment of imenu--sort-by-name.
;
; Revision 1.1  1999/08/27  11:37:36  dadams
; Initial revision
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;; Code:

(require 'cl) ;; cadr, when
(require 'imenu)

;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Customizable variables

;; I was doing this as a defvar in `imenu-.el', which I was loading
;; before `imenu.el' (hence, before `imenu+.el' too).  But newer
;; versions of `imenu.el' now preset a nil value for
;; `imenu-sort-function', via ###autoload, which means that a user
;; defvar for it is not taken into account.  I've therefore resorted
;; to doing it this way (ugh! sorry about that).
(defconst imenu-sort-function 'imenu--sort-by-name)

;;;###autoload
(defvar imenu-emacs-key-defn-regexp-1 "(\\s-*\\(\\(global\\|local\\)-\\(un\\)?\
set-key\\|undefine-keys-bound-to\\)\\s-*\\(\"[^\"]+\"\\|[[][^]]+[]]\\)"
  "*Regexp that recognizes Emacs key definitions.
Cf. `imenu-emacs-key-defn-regexp-2'.")

;;;###autoload
(defvar imenu-emacs-key-defn-regexp-2 "(\\s-*\\(define-key\\(-after\\)?\\s-+\
\\|substitute-key-definition\\s-+'\\)\\(\\S-+\\)\\s-*'?\\(\"[^\"]+\"\\|[[][^]]+[]]\\)"
  "*Regexp that recognizes Emacs key definitions.
Cf. `imenu-emacs-key-defn-regexp-1'.")

;;;###autoload
(defvar imenu-lisp-type-defn-regexp 
"(\\s-*def\\(type\\|class\\|ine-condition\\)\\s-+\
'?\\([^ \t()]+\\)"
  "*Regexp that recognizes Lisp type definitions.")

;;;###autoload
(defvar imenu-lisp-struct-defn-regexp "(\\s-*defstruct\\s-*(\\([^ \t()]+\\)"
  "*Regexp that recognizes Lisp structure (defstruct) definitions.")

;;;###autoload
(defvar imenu-lisp-fn-defn-regexp 
"(\\s-*\\(def\\(un\\|subst\\|advice\\|ine-function\\)\\|\
\\(fset\\|defalias\\)\\s-+'\\)\\s-+\\([^ \t()]+\\)"
  "*Regexp that recognizes Lisp function definitions.")

;;;###autoload
(defvar imenu-lisp-macro-defn-regexp "(\\s-*defmacro\\s-+\\([^ \t()]+\\)"
  "*Regexp that recognizes Lisp macro definitions.")

;;;###autoload
(defvar imenu-lisp-var-defn-regexp 
"(\\s-*def\\(var\\|const\\|custom\\)\\s-+\\([^ \t()]+\\)"
  "*Regexp that recognizes global Lisp variable definitions.")


;; REPLACES ORIGINAL in `lisp-mode.el':
;; Functions, Macros, Structures added.
;; Ideally, this should be a defvar in a file `lisp-mode-.el' that
;; is loaded before `lisp-mode.el'.
(defconst lisp-imenu-generic-expression
  (list
    (list "Functions" imenu-lisp-fn-defn-regexp 4)
    (list "Macros" imenu-lisp-macro-defn-regexp 1)
    (list "Variables" imenu-lisp-var-defn-regexp 2)
    (list "Types" imenu-lisp-type-defn-regexp 2)
    (list "Structures" imenu-lisp-struct-defn-regexp 1)
    )
  "*Imenu generic expression for Lisp mode.
See `imenu-generic-expression'.")

;;;###autoload
(defvar emacs-lisp-imenu-generic-expression
  (list
    (list "Keys" imenu-emacs-key-defn-regexp-1 4)
    (list "Keys in Maps" imenu-emacs-key-defn-regexp-2 4)
    (list "Functions" imenu-lisp-fn-defn-regexp 4)
    (list "Macros" imenu-lisp-macro-defn-regexp 1)
    (list "Variables" imenu-lisp-var-defn-regexp 2)
    (list "Types" imenu-lisp-type-defn-regexp 2)
    (list "Structures" imenu-lisp-struct-defn-regexp 1)
    )
  "*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
                 (imenu-add-defs-to-menubar)
               (error nil))))
(add-hook 'emacs-lisp-mode-hook
          '(lambda ()
             (setq imenu-generic-expression
                   emacs-lisp-imenu-generic-expression)
             (condition-case nil
                 (imenu-add-defs-to-menubar)
               (error nil))))


;;; Internal variables

(defvar imenu-last-sort-function nil
  "The last non-nil value for `imenu-sort-function' during this session.")

;;;###autoload
(defun toggle-imenu-sort (force-p)
  "Toggle imenu between sorting menus and not.
Non-nil prefix FORCE-P => Sort iff FORCE-P >= 0."
  (interactive "P")
  (cond (imenu-sort-function
         (setq imenu-last-sort-function imenu-sort-function) ; Save it.
         (when (or (null force-p) (<= (prefix-numeric-value force-p) 0))
           (setq imenu-sort-function nil))) ; Don't sort.
        ((or (null force-p) (> (prefix-numeric-value force-p) 0)) ; Ask to sort
         (if imenu-last-sort-function  ; Sort using saved sort fn.
             (setq imenu-sort-function imenu-last-sort-function)
           (error "You first need to set `imenu-sort-function'."))))
  (if imenu-sort-function
      (message "Imenus are now being sorted via `%s'." imenu-sort-function)
    (message "Imenus are no longer being sorted.")))


;;;###autoload
(defun imenu-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 imenu--sort-submenu (submenu predicate)
  (let ((menu-name (car submenu))
        (menu-items (cdr submenu)))
    (cons menu-name (if (and (consp menu-items)
                             (consp (cdr menu-items)))
                        (sort menu-items predicate)
                      menu-items))))


;;; REPLACES ORIGINAL in `imenu.el'.
;;; Sorts each submenu before splitting submenus, instead of sorting among 
submenus after.
;;;###autoload
(defun imenu-update-menubar ()
  (and (current-local-map)
       (keymapp (lookup-key (current-local-map) [menu-bar index]))
       (let ((index-alist (imenu--make-index-alist t)))
         ;; Don't bother updating if the index-alist has not changed
         ;; since the last time we did it.
         (or (equal index-alist imenu--last-menubar-index-alist)
             (let (menu menu1 old)
               (setq imenu--last-menubar-index-alist index-alist)
               (setq index-alist
                     (imenu--split-submenus
                      (if imenu-sort-function
                          (mapcar (lambda (sm) (imenu--sort-submenu sm 
imenu-sort-function))
                                  index-alist)
                        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)))))))


;;; REPLACES ORIGINAL in `imenu.el'.
;;; Sorts each submenu before splitting submenus, instead of sorting among 
submenus after.
;;;###autoload
(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 and EVENT is a mouse event.

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) (imenu--sort-submenu sm 
imenu-sort-function))
                                 index-alist)
                       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 (cadr 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))))))))


;;;;;;;;;;;;;;;;;;

(provide 'imenu+)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `imenu+.el' ends here