/[emacs]/emacs/lisp/imenu.el
ViewVC logotype

Diff of /emacs/lisp/imenu.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.86 by pj, Sun Jul 15 16:15:34 2001 UTC revision 1.87 by monnier, Tue Nov 20 00:17:15 2001 UTC
# Line 207  The variable `imenu-case-fold-search' de Line 207  The variable `imenu-case-fold-search' de
207  regexp matches are case sensitive, and `imenu-syntax-alist' can be  regexp matches are case sensitive, and `imenu-syntax-alist' can be
208  used to alter the syntax table for the search.  used to alter the syntax table for the search.
209    
210  For example, see the value of `lisp-imenu-generic-expression' used by  For example, see the value of `fortran-imenu-generic-expression' used by
211  `fortran-mode' with `imenu-syntax-alist' set locally to give the  `fortran-mode' with `imenu-syntax-alist' set locally to give the
212  characters which normally have \"symbol\" syntax \"word\" syntax  characters which normally have \"symbol\" syntax \"word\" syntax
213  during matching.")  during matching.")
# Line 517  This variable is local in all buffers, o Line 517  This variable is local in all buffers, o
517          (setq keep-at-top (cons imenu--rescan-item nil)          (setq keep-at-top (cons imenu--rescan-item nil)
518                menulist (delq imenu--rescan-item menulist)))                menulist (delq imenu--rescan-item menulist)))
519      (setq tail menulist)      (setq tail menulist)
520      (while tail      (dolist (item tail)
521        (if (imenu--subalist-p (car tail))        (if (imenu--subalist-p item)
522            (setq keep-at-top (cons (car tail) keep-at-top)            (setq keep-at-top (cons item keep-at-top)
523                  menulist (delq (car tail) menulist)))                  menulist (delq item menulist))))
       (setq tail (cdr tail)))  
524      (if imenu-sort-function      (if imenu-sort-function
525          (setq menulist          (setq menulist
526                (sort                (sort
527                 (let ((res nil)                 (copy-sequence menulist)
                      (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))))  
528                 imenu-sort-function)))                 imenu-sort-function)))
529      (if (> (length menulist) imenu-max-items)      (if (> (length menulist) imenu-max-items)
530          (let ((count 0))          (let ((count 0))
# Line 631  as a way for the user to ask to recalcul Line 625  as a way for the user to ask to recalcul
625          alist)          alist)
626         t))         t))
627    
628  (defun imenu--create-keymap-2 (alist counter &optional commands)  (defun imenu--create-keymap-1 (title alist)
629    (let ((map nil))    (let ((counter 0))
630      (mapcar      (list* 'keymap title
631       (lambda (item)             (mapcar
632         (cond              (lambda (item)
633          ((imenu--subalist-p item)                (list* (car item) (car item)
634           (nconc (list (setq counter (1+ counter))                       (cond
635                        (car item) 'keymap (car item))                        ((imenu--subalist-p item)
636                  (imenu--create-keymap-2 (cdr item) (+ counter 10) commands)))                         (imenu--create-keymap-1 (car item) (cdr item)))
637          (t                        (t
638           (let ((end (if commands `(lambda ()                         `(lambda () (interactive)
639                                      (interactive)                            (imenu--menubar-select ',item))))))
640                                      (imenu--menubar-select ',item))              alist))))
                       (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))))  
641    
642  (defun imenu--in-alist (str alist)  (defun imenu--in-alist (str alist)
643    "Check whether the string STR is contained in multi-level ALIST."    "Check whether the string STR is contained in multi-level ALIST."
# Line 686  as a way for the user to ask to recalcul Line 664  as a way for the user to ask to recalcul
664      res))      res))
665    
666  (defvar imenu-syntax-alist nil  (defvar imenu-syntax-alist nil
667    "Alist of syntax table modifiers to use while executing `imenu--generic-function'.    "Alist of syntax table modifiers to use while in `imenu--generic-function'.
668    
669  The car of the assocs may be either a character or a string and the  The car of the assocs may be either a character or a string and the
670  cdr is a syntax description appropriate fo `modify-syntax-entry'.  For  cdr is a syntax description appropriate fo `modify-syntax-entry'.  For
# Line 757  Their results are gathered into an index Line 735  Their results are gathered into an index
735  (defvar imenu-case-fold-search t  (defvar imenu-case-fold-search t
736    "Defines whether `imenu--generic-function' should fold case when matching.    "Defines whether `imenu--generic-function' should fold case when matching.
737    
738  This buffer-local variable should be set (only) by initialization code  This variable should be set (only) by initialization code
739  for modes which use `imenu--generic-function'.  If it is not set, that  for modes which use `imenu--generic-function'.  If it is not set, that
740  function will use the current value of `case-fold-search' to match  function will use the current value of `case-fold-search' to match
741  patterns.")  patterns.")
# Line 797  PATTERNS." Line 775  PATTERNS."
775          (table (copy-syntax-table (syntax-table)))          (table (copy-syntax-table (syntax-table)))
776          (slist imenu-syntax-alist))          (slist imenu-syntax-alist))
777      ;; Modify the syntax table used while matching regexps.      ;; Modify the syntax table used while matching regexps.
778      (while slist      (dolist (syn slist)
779        ;; The character(s) to modify may be a single char or a string.        ;; The character(s) to modify may be a single char or a string.
780        (if (numberp (caar slist))        (if (numberp (car syn))
781            (modify-syntax-entry (caar slist) (cdar slist) table)            (modify-syntax-entry (car syn) (cdr syn) table)
782          (mapc (lambda (c)          (dolist (c (car syn))
783                  (modify-syntax-entry c (cdar slist) table))            (modify-syntax-entry c (cdr syn) table))))
               (caar slist)))  
       (setq slist (cdr slist)))  
784      (goto-char (point-max))      (goto-char (point-max))
785      (imenu-progress-message prev-pos 0 t)      (imenu-progress-message prev-pos 0 t)
786      (unwind-protect                     ; for syntax table      (unwind-protect                     ; for syntax table
# Line 812  PATTERNS." Line 788  PATTERNS."
788            (set-syntax-table table)            (set-syntax-table table)
789            ;; map over the elements of imenu-generic-expression            ;; map over the elements of imenu-generic-expression
790            ;; (typically functions, variables ...)            ;; (typically functions, variables ...)
791            (mapc            (dolist (pat patterns)
792             (lambda (pat)              (let ((menu-title (car pat))
793               (let ((menu-title (car pat))                    (regexp (nth 1 pat))
794                     (regexp (nth 1 pat))                    (index (nth 2 pat))
795                     (index (nth 2 pat))                    (function (nth 3 pat))
796                     (function (nth 3 pat))                    (rest (nthcdr 4 pat)))
797                     (rest (nthcdr 4 pat)))                ;; Go backwards for convenience of adding items in order.
798                 ;; Go backwards for convenience of adding items in order.                (goto-char (point-max))
799                 (goto-char (point-max))                (while (re-search-backward regexp nil t)
800                 (while (re-search-backward regexp nil t)                  (imenu-progress-message prev-pos nil t)
801                   (imenu-progress-message prev-pos nil t)                  (setq beg (match-beginning index))
802                   (setq beg (match-beginning index))                  ;; Add this sort of submenu only when we've found an
803                   ;; Add this sort of submenu only when we've found an                  ;; item for it, avoiding empty, duff menus.
804                   ;; item for it, avoiding empty, duff menus.                  (unless (assoc menu-title index-alist)
805                   (unless (assoc menu-title index-alist)                    (push (list menu-title) index-alist))
806                     (push (list menu-title) index-alist))                  (if imenu-use-markers
807                   (if imenu-use-markers                      (setq beg (copy-marker beg)))
808                       (setq beg (copy-marker beg)))                  (let ((item
809                   (let ((item                         (if function
810                          (if function                             (nconc (list (match-string-no-properties index)
811                              (nconc (list (match-string-no-properties index)                                          beg function)
812                                           beg function)                                    rest)
813                                     rest)                           (cons (match-string-no-properties index)
814                            (cons (match-string-no-properties index)                                 beg)))
815                                  beg)))                        ;; This is the desired submenu,
816                         ;; This is the desired submenu,                        ;; starting with its title (or nil).
817                         ;; starting with its title (or nil).                        (menu (assoc menu-title index-alist)))
818                         (menu (assoc menu-title index-alist)))                    ;; Insert the item unless it is already present.
819                     ;; Insert the item unless it is already present.                    (unless (member item (cdr menu))
820                     (unless (member item (cdr menu))                      (setcdr menu
821                       (setcdr menu                              (cons item (cdr menu))))))))
                              (cons item (cdr menu))))))))  
            patterns)  
822            (set-syntax-table old-table)))            (set-syntax-table old-table)))
823      (imenu-progress-message prev-pos 100 t)      (imenu-progress-message prev-pos 100 t)
824      ;; Sort each submenu by position.      ;; Sort each submenu by position.
825      ;; This is in case one submenu gets items from two different regexps.      ;; This is in case one submenu gets items from two different regexps.
826      (let ((tail index-alist))      (dolist (item index-alist)
827        (while tail        (when (listp item)
828          (if (listp (car tail))          (setcdr item (sort (cdr item) 'imenu--sort-by-position))))
             (setcdr (car tail)  
                     (sort (cdr (car tail)) 'imenu--sort-by-position)))  
         (setq tail (cdr tail))))  
829      (let ((main-element (assq nil index-alist)))      (let ((main-element (assq nil index-alist)))
830        (nconc (delq main-element (delq 'dummy index-alist))        (nconc (delq main-element (delq 'dummy index-alist))
831               (cdr main-element)))))               (cdr main-element)))))
# Line 865  PATTERNS." Line 836  PATTERNS."
836  ;;;  ;;;
837  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
838    
839    ;; See also info-lookup-find-item
840    (defun imenu-find-default (guess completions)
841      "Fuzzily find an item based on GUESS inside the alist COMPLETIONS."
842      (catch 'found
843        (let ((case-fold-search t))
844          (if (assoc guess completions) guess
845            (dolist (re (list (concat "\\`" (regexp-quote guess) "\\'")
846                              (concat "\\`" (regexp-quote guess))
847                              (concat (regexp-quote guess) "\\'")
848                              (regexp-quote guess)))
849              (dolist (x completions)
850                (if (string-match re (car x)) (throw 'found (car x)))))))))
851    
852  (defun imenu--completion-buffer (index-alist &optional prompt)  (defun imenu--completion-buffer (index-alist &optional prompt)
853    "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.    "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
854    
# Line 879  Returns t for rescan and otherwise a pos Line 863  Returns t for rescan and otherwise a pos
863                                          (car item))                                          (car item))
864                    (cdr item)))                    (cdr item)))
865            index-alist)))            index-alist)))
866        (when (stringp name)
867          (setq name (or (imenu-find-default name prepared-index-alist) name)))
868      (cond (prompt)      (cond (prompt)
869            ((and name (imenu--in-alist name prepared-index-alist))            ((and name (imenu--in-alist name prepared-index-alist))
870             (setq prompt (format "Index item (default %s): " name)))             (setq prompt (format "Index item (default %s): " name)))
# Line 896  Returns t for rescan and otherwise a pos Line 882  Returns t for rescan and otherwise a pos
882                 (function                 (function
883                  (lambda ()                  (lambda ()
884                    (let ((buffer (current-buffer)))                    (let ((buffer (current-buffer)))
885                      (save-excursion                      (with-current-buffer "*Completions*"
                       (set-buffer "*Completions*")  
886                        (setq completion-reference-buffer buffer)))))))                        (setq completion-reference-buffer buffer)))))))
887            ;; Make a completion question            ;; Make a completion question
888            (setq name (completing-read prompt            (setq name (completing-read prompt
889                                        prepared-index-alist                                        prepared-index-alist
890                                        nil t nil 'imenu--history-list name)))))                                        nil t nil 'imenu--history-list name)))))
891      (cond ((not (stringp name))      (cond ((not (stringp name)) nil)
892             nil)            ((string= name (car imenu--rescan-item)) t)
           ((string= name (car imenu--rescan-item))  
            t)  
893            (t            (t
894             (setq choice (assoc name prepared-index-alist))             (setq choice (assoc name prepared-index-alist))
895             (if (imenu--subalist-p choice)             (if (imenu--subalist-p choice)
# Line 920  INDEX-ALIST is the buffer index and EVEN Line 903  INDEX-ALIST is the buffer index and EVEN
903    
904  Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."  Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."
905    (setq index-alist (imenu--split-submenus index-alist))    (setq index-alist (imenu--split-submenus index-alist))
906    (let* ((menu  (imenu--split-menu index-alist    (let* ((menu (imenu--split-menu index-alist (or title (buffer-name))))
907                                     (or title (buffer-name))))           (map (imenu--create-keymap-1 (car menu)
908          position)                                        (if (< 1 (length (cdr menu)))
909      (setq menu (imenu--create-keymap-1 (car menu)                                            (cdr menu)
910                                         (if (< 1 (length (cdr menu)))                                          (cdr (car (cdr menu)))))))
911                                             (cdr menu)      (popup-menu map event)))
                                          (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))))))))  
912    
913  (defun imenu-choose-buffer-index (&optional prompt alist)  (defun imenu-choose-buffer-index (&optional prompt alist)
914    "Let the user select from a buffer index and return the chosen index.    "Let the user select from a buffer index and return the chosen index.
# Line 978  not. Line 930  not.
930  The returned value is of the form (INDEX-NAME . INDEX-POSITION)."  The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
931    (let (index-alist    (let (index-alist
932          (mouse-triggered (listp last-nonmenu-event))          (mouse-triggered (listp last-nonmenu-event))
933          (result t) )          (result t))
934      ;; If selected by mouse, see to that the window where the mouse is      ;; If selected by mouse, see to that the window where the mouse is
935      ;; really is selected.      ;; really is selected.
936      (and mouse-triggered      (and mouse-triggered
# Line 1040  A trivial interface to `imenu-add-to-men Line 992  A trivial interface to `imenu-add-to-men
992                 (setq index-alist (imenu--split-submenus index-alist))                 (setq index-alist (imenu--split-submenus index-alist))
993                 (setq menu (imenu--split-menu index-alist                 (setq menu (imenu--split-menu index-alist
994                                               (buffer-name)))                                               (buffer-name)))
995                 (setq menu1 (imenu--create-keymap-1 (car menu)                 (setq menu1 (imenu--create-keymap-1 (car menu)
996                                                     (if (< 1 (length (cdr menu)))                                                     (if (< 1 (length (cdr menu)))
997                                                         (cdr menu)                                                         (cdr menu)
998                                                       (cdr (car (cdr menu))))                                                       (cdr (car (cdr menu))))))
                                                    t))  
999                 (setq old (lookup-key (current-local-map) [menu-bar index]))                 (setq old (lookup-key (current-local-map) [menu-bar index]))
1000                 (setcdr old (cdr menu1)))))))                 (setcdr old (cdr menu1)))))))
1001    
1002  (defun imenu--menubar-select (item)  (defun imenu--menubar-select (item)
1003    "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."
1004    (if (equal item imenu--rescan-item)    (if (equal item imenu--rescan-item)
1005        (progn        (progn
1006          (imenu--cleanup)          (imenu--cleanup)
1007          (setq imenu--index-alist nil)          (setq imenu--index-alist nil)
1008          (imenu-update-menubar))          (imenu-update-menubar)
1009      (imenu item)))          t)
1010        (imenu item)
1011        nil))
1012    
1013  (defun imenu-default-goto-function (name position &optional rest)  (defun imenu-default-goto-function (name position &optional rest)
1014    "Move the point to the given position.    "Move the point to the given position.
# Line 1078  for more information." Line 1031  for more information."
1031    ;; Convert a string to an alist element.    ;; Convert a string to an alist element.
1032    (if (stringp index-item)    (if (stringp index-item)
1033        (setq index-item (assoc index-item (imenu--make-index-alist))))        (setq index-item (assoc index-item (imenu--make-index-alist))))
1034    (and index-item    (when index-item
1035         (progn      (push-mark)
1036           (push-mark)      (let* ((is-special-item (listp (cdr index-item)))
1037           ;; Fixme: sort this out so that we can use menu-item with             (function
1038           ;; :key-sequence in imenu--create-keymap-2.              (if is-special-item
1039           (let* ((is-special-item (listp (cdr index-item)))                  (nth 2 index-item) imenu-default-goto-function))
1040                  (function             (position (if is-special-item
1041                   (if is-special-item                           (cadr index-item) (cdr index-item)))
1042                       (nth 2 index-item) imenu-default-goto-function))             (rest (if is-special-item (cddr index-item))))
1043                 (position (if is-special-item        (apply function (car index-item) position rest))
1044                               (cadr index-item) (cdr index-item)))      (run-hooks 'imenu-after-jump-hook)))
                (rest (if is-special-item (cddr index-item))))  
            (apply function (car index-item) position rest))))  
   (run-hooks 'imenu-after-jump-hook))  
1045    
1046  (dolist (mess  (dolist (mess
1047           '("^No items suitable for an index found in this buffer$"           '("^No items suitable for an index found in this buffer$"

Legend:
Removed from v.1.86  
changed lines
  Added in v.1.87

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26