xemacs-beta: lisp/packages/func-menu.el comparison

comparison lisp/packages/func-menu.el @ 82:6a378aca36af r20-0b91

Import from CVS: tag r20-0b91

author	cvs
date	Mon, 13 Aug 2007 09:07:36 +0200
parents	131b0175ea99
children	4be1180a9e89

comparison

equal deleted inserted replaced

-:ebca3d831cea
+:6a378aca36af
 ;;; func-menu.el         --- Jump to a function within a buffer.
 ;;;
 ;;; David Hughes <ukchugd@ukpmr.cs.philips.nl>
-;;; Last modified: David Hughes 2nd May 1996
+;;; Last modified: David Hughes 13th January 1997
-;;; Version: 2.43
+;;; Version: 2.45
 ;;; Keywords: tools, c, lisp
 ;;;
 ;;; 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)
 ;;; to where you were. Alternatively, you can use enter the name of the
 ;;; desired function via the minibuffer which offers completing read input. In
 ;;; addition, the name of the function before point is optionally displayed in
 ;;; the modeline.
 ;;;
-;;; Support for non X Windows versions of Emacs:
+;;; Support for non X Window versions of Emacs:
-;;; ============================================
+;;; ===========================================
 ;;; This package can also be used for non X versions of Emacs. In this case,
 ;;; only modeline display and completing read input from the minibuffer are
 ;;; possible.
 ;;;
 ;;; Modes supported:
 ;;; Postscript, Prolog, PVS, Python, SGML, Scheme, Tcl, Verilog
 ;;;
 ;;; Acknowledgements:
 ;;; =================
 ;;;
+;;; Fix to fume-function-name-regexp-c
+;;; Jonathan Edwards <edwards@intranet.com>
+;;;
+;;; Speedup for fume-cc-inside-comment
+;;; Peter Pezaris <pez@dwwc.com>
+;;;
+;;; Made menu placement more flexible
+;;; Bob Weiner <weiner@infodock.com>
+;;;
 ;;; Fortran90 regexp
 ;;; John Turner <turner@xdiv.lanl.gov>
 ;;;
 ;;; Patch to error trap in fume-rescan-buffer
 ;;; Andy Piper <andyp@parallax.co.uk>
 ;;;
 ;;; Java support
+;;; Bob Weiner <weiner@infodock.com>
 ;;; Heddy Boubaker <boubaker@dgac.fr>
 ;;;
 ;;; Patch for fume-rescan-buffer{-trigger}
 ;;; Christoph Wedler <wedler@vivaldi.fmi.uni-passau.de>
 ;;;
 ;;;
 ;;; SGML support; submenu indexing
 ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
 ;;;
 ;;; Extensions to fume-function-name-regexp-lisp
+;;; Vladimir Alexiev <vladimir@cs.ualberta.ca>
 ;;; Kari Heinola <kph@dpe.fi>
 ;;; Milo A. Chan <chan@jpmorgan.com>
 ;;; Jack Repenning <jackr@step7.informix.com>
 ;;; Cedric Beust <Cedric.Beust@sophia.inria.fr>
 ;;; Joachim Krumnow <krumnow@srsir02.ext.sap-ag.de>
 ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
 ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
 ;;;
 ;;; Assembly support
-;;; Bob Weiner <weiner@mot.com>
+;;; Bob Weiner <weiner@infodock.com>
 ;;;
 ;;; Removal of cl dependencies
 ;;; Russell Ritchie <russell@gssec.bt.co.uk>
 ;;;
 ;;; C++ mode enhancemencements for func-menu
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;  Environment Initialisation  ;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst fume-version "2.43")
+(defconst fume-version "2.45")
 (defconst fume-developer "David Hughes <ukchugd@ukpmr.cs.philips.nl>")
 (defun fume-about ()
 (interactive)
 (sit-for 0)
 (message "Func-Menu version %s, � 1996 %s" fume-version fume-developer))
 (defconst fume-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
 (defmacro fume-defvar-local (var value &optional doc)
 "Defines SYMBOL as an advertised variable.
 (boundp 'local-post-command-hook))
 (cond ((fboundp 'add-submenu)
 (defconst fume-add-submenu 'add-submenu)
 (defun fume-munge-menu-args (menu-name submenu before)
-(list nil (cons menu-name submenu) before)))
+(list fume-menu-path (cons menu-name submenu) before)))
 (t
 (defconst fume-add-submenu 'add-menu)
 (defun fume-munge-menu-args (menu-name submenu before)
-(list nil menu-name submenu before))))
+(list fume-menu-path menu-name submenu before))))
 (defun fume-add-submenu (menu-name submenu before)
 (apply fume-add-submenu (fume-munge-menu-args menu-name submenu before)))
 (defconst fume-not-tty
 Note, this is a buffer-local variable.")
 (defvar fume-buffer-name "*Function List*"
 "Name of buffer used to list functions when fume-list-functions called")
-(fume-defvar-local
+(defvar fume-menubar-menu-name "Functions"
-fume-menubar-menu-name "Functions"
 "*Set this to the string you want to appear in the menubar")
+;;; Bob Weiner <weiner@infodock.com>
+(defvar fume-menu-path nil
+"Menubar menu under which the function menu should be installed.
+Nil means install it on the menubar itself.  Otherwise, it should be a list
+of strings, each string names a successively deeper menu under which the
+new menu should be located.")
 (defvar fume-menubar-menu-location "Buffers"
 "*Set this nil if you want the menu to appear last on the menubar.
 Otherwise set this to the menu you want \"Functions\" to appear in front of.")
 ;;; Every fume-function-name-regexp-<language> should uniquely identify a
 ;;; function for that certain language.
 ;;; Lisp
 ;;;
-;;; Jack Repenning <jackr@step7.informix.com>
+;;; Vladimir Alexiev <vladimir@cs.ualberta.ca>
-;;; Cedric Beust <Cedric.Beust@sophia.inria.fr>
 (defvar fume-function-name-regexp-lisp
 (concat
-"\\(^(defun+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
+"^[ \t]*"                            ; Allow whitespace   |(or (fboundp 'foo)
-"\\|"
+;  for the construct |    (defun foo ()
-"\\(^(defsubst+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
+"(\\(def[^vc][a-z]*\\)"              ; Allow (def* except (defvar, (defconst
-"\\|"
+"\\s-+"                              ; At least one whitespace
-"\\(^(defmacro+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
+"'?[#:?A-Za-z0-9_+>-]+"              ; Allow (defalias 'foo 'bar)
-"\\|"
+"\\s-*"                              ; Whitespace
-"\\(^(defadvice+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
+"\\(nil\\|(\\)"                      ; nil or (arg list
-"\\|"
-"\\(^(de+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
-"\\|"
-"\\(^(dmd+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
 )
 "Expression to get lisp function names")
 ;;; C
 ;;;
 ;;; Danny Bar-Dov <danny@acet02.amil.co.il>
 (defvar fume-function-name-regexp-c
 (concat
-"^[a-zA-Z0-9]+\\s-?"                ; type specs; there can be no
+"^[a-zA-Z0-9_]+\\s-?"                ; type specs; there can be no
-"\\([a-zA-Z0-9_*]+\\s-+\\)?"        ; more than 3 tokens, right?
+"\\([a-zA-Z0-9_*]+\\s-+\\)?"         ; more than 3 tokens, right?
 "\\([a-zA-Z0-9_*]+\\s-+\\)?"
-"\\([*&]+\\s-*\\)?"                 ; pointer
+"\\([*&]+\\s-*\\)?"                  ; pointer
-"\\([a-zA-Z0-9_*]+\\)[ \t\n]*("     ; name
+"\\([a-zA-Z0-9_*]+\\)[ \t\n]*("      ; name
 )
 "Expression to get C function names")
 ;;; C++
 ;;;
 ;;;
 ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
 (defvar fume-function-name-regexp-make
 "^\\(\\(\\$\\s(\\)?\\(\\w\\|\\.\\)+\\(:sh\\)?\\(\\s)\\)?\\)\\s *\\(::?\\|\\+?=\\)"
 "Expression to get makefile target names")
+(add-hook 'makefile-mode-hook 'fume-add-menubar-entry)
 ;;; Directory Listings
 ;;;
 ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
 ;;; regexp stolen from font-lock-mode
 ;;; Matt Sale <mdsale@icdc.delcoelect.com>
 (defvar fume-function-name-regexp-verilog
 "^\\(task\\|function\\|module\\|primitive\\)[ \t]+\\([A-Za-z0-9_+-]*\\)[ \t]*(?"
 "Expression to get verilog module names")
+;;; Idl
+;;;
+;;; Lubos Pochman <lubos@rsinc.com>
+(defvar fume-function-name-regexp-idl
+(cons "^\\s *\\([pP][rR][oO]\\|[fF][uU][nN][cC][tT][iI][oO][nN]\\)\\s +\\([A-Za-z][A-Za-z0-9_$]*\\)" 2)
+"Expression to get Idl function Names")
 ;;; Assembly
 (defvar fume-function-name-regexp-asm
 "^\\([a-zA-Z_.$][a-zA-Z0-9_.$]*\\)[ \t]*:"
 "Expression to get assembly label names")
 (fame-mode . fume-function-name-regexp-fame)
 ;; Verilog
 (verilog-mode . fume-function-name-regexp-verilog)
+;; Idl
+(idl-mode . fume-function-name-regexp-idl)
 ;; Assembly
 (asm-mode . fume-function-name-regexp-asm)
 )
 "The connection between a mode and the regexp that matches function names.")
 "Searches for the next function in BUFFER."
 (set-buffer buffer)
 ;; Search for the function
 (if (re-search-forward fume-function-name-regexp nil t)
 (let ((char (progn
-(backward-up-list 1)
+(if (string-match
+"[({[]"
+(char-to-string (char-after (1- (point)))))
+(backward-char)
+(forward-word -1))
 (save-excursion
 (goto-char (scan-sexps (point) 1))
 (skip-chars-forward "[ \t\n]")
 (following-char)))))
 ;; Skip this function name if it is a prototype declaration.
 (if (looking-at ":")
 (setq end (1- end)))
 (cons (buffer-substring beg end) beg))))
 ;;; Specialised routine to get the next C function name in the buffer.
+;;; Modified 16/12/96: Jerome Bertorelle <bertorel@telspace.alcatel.fr>
 ;;;
 (defun fume-find-next-c-function-name (buffer)
 "Searches for the next C function in BUFFER."
 (set-buffer buffer)
 ;; Search for the function
 (goto-char (scan-sexps (point) 1))
 (skip-chars-forward "[ \t\n]")
 (following-char)))))
 ;; Skip this function name if it is a prototype declaration.
 (if (eq char ?\;)
-(fume-find-next-function-name buffer)
+(fume-find-next-c-function-name buffer)
 (let (beg
 name)
 ;; Get the function name and position
 (forward-sexp -1)
 (setq beg (point))
 (re-search-backward "\"," nil t)
 (setq name
 (format "%s %s"
 name
 (buffer-substring beg (point))))))))
-;; kludge to avoid 'void' in menu
+;; kludge to avoid 'void' etc in menu
-(if (string-match "^void\\s-*" name)
+(if (string-match "^void$\\|^if$\\|^switch$\\|^while$" name)
-(fume-find-next-function-name buffer)
+(fume-find-next-c-function-name buffer)
 (cons name beg)))))))
+;;; Peter Pezaris <pez@dwwc.com>
+;;;
 (defun fume-cc-inside-comment ()
-(let ((here (point))
+(memq (buffer-syntactic-context) '(comment block-comment)))
-(bol-point (save-excursion (beginning-of-line) (point))))
-(or
-(save-excursion (and (re-search-backward "\/\/" bol-point t 1) t))
-(save-excursion
-(and
-(re-search-backward "\\(/[*]\\)\\|\\([*]/\\)" (point-min) t 1)
-(looking-at "/[*]")
-(goto-char here)
-(or (beginning-of-line 1) t)
-(re-search-forward "[ \t]*/?[*][ \t]*" here t 1)
-t)))))
 ;;; <jrm@odi.com>
 ;;; <ajp@eng.cam.ac.uk>
 ;;; <schittko@fokus.gmd.de>
+;;; <ukchugd@ukpmr.cs.philips.nl> - speedup, David Hughes 24th November 1996
 ;;;
 (defun fume-match-find-next-function-name (buffer)
-"General next function name in BUFFER finder using match.
+;; General next function name in BUFFER finder using match.
-The regexp is assumed to be a two item list the car of which is the regexp to
+;; The regexp is assumed to be a two item list the car of which is the regexp
-use, and the cdr of which is the match position of the function name."
+;; to use, and the cdr of which is the match position of the function name
 (set-buffer buffer)
-(let ((result nil)
+(let ((r (car fume-function-name-regexp))
-(continue t)
+(p (cdr fume-function-name-regexp)))
-(regexp (car fume-function-name-regexp)))
+(catch 'found
-(while continue
+(while (re-search-forward r nil t)
-;; Search for the function
+(catch 'skip
-(if (re-search-forward regexp nil t)
+(if (fume-cc-inside-comment) (throw 'skip t))
-(if (fume-cc-inside-comment)
+(save-excursion
-() ; skip spurious finds in comments
+(re-search-backward r nil t)
-(let ((first-token (save-excursion
+(if (string= "typedef" (fume-what-looking-at)) (throw 'skip t))
-(re-search-backward regexp nil t)
+(re-search-forward r nil t))
-(prog1 (fume-what-looking-at)
+(backward-up-list 1)
-(re-search-forward regexp nil t))))
+(save-excursion
-(last-char (progn
+(goto-char (scan-sexps (point) 1))
-(backward-up-list 1)
+(if (eq ?\; (following-char)) (throw 'skip t))) ; skip prototypes
-(save-excursion
+(throw
-(goto-char (scan-sexps (point) 1))
+'found
-(following-char)))))
+(cons (buffer-substring (setq p (match-beginning p)) (point)) p))))
-;; Skip function name if it's a prototype or typedef declaration
+nil)))
-(if (or (eq last-char ?\;) (string= first-token "typedef"))
-nil
-(setq result
-;; Get function name and position including scope
-(cons (buffer-substring
-(match-beginning (cdr fume-function-name-regexp))
-(point))
-(match-beginning (cdr fume-function-name-regexp)))
-continue nil))))
-(setq continue nil)))
-result))
 ;;; Specialised routine to find the next Perl function
 ;;;
 (defun fume-find-next-perl-function-name (buffer)
 "Searches for the next Perl function in BUFFER."
 (fume-find-next-sexp buffer))
 ;;; Specialised routine to find the next Java function
+;;; Bob Weiner <weiner@infodock.com>
 ;;; Heddy Boubaker <boubaker@dgac.fr>
 ;;;
 (defun fume-find-next-java-function-name (buffer)
 "Searches for the next Java function in BUFFER."
 (set-buffer buffer)
 (end (match-end       1)))
 (goto-char (match-beginning 2))
 (forward-sexp)
 (if (and (looking-at "[^;(]*{")
 (not (fume-cc-inside-comment)))
-;; This is a method definition and we're not
+;; This is a method definition and we're not in a comment
-;; in a comment.
 (let ((str (buffer-substring beg end)))
-(or (string-match "if\\|switch\\|catch\\|for\\|while" str)
+;; Bob Weiner <weiner@infodock.com> added exact match
-;; These constructs look like methods definitions
+;; delimiters so function names that happen to contain
-;; but are not.
+;; any of these terms are not eliminated.  The old version
+;; would ignore "notify()" since it contained "if".
+(or (string-match "\\`\\(if\\|switch\\|catch\\|for\\|while\\)\\'"
+str)
+;; These constructs look like method definitions but are not
 (cons str beg)))
 (fume-find-next-java-function-name buffer)))))
 ;;; Specialised routine to find the next Python function
 ;;; Shuichi Koga <skoga@virginia.edu>
 (if (re-search-forward fume-function-name-regexp nil t)
 (let ((beg (match-beginning 2))
 (end (match-end 2)))
 (cons (buffer-substring beg end) beg))))
+;;; Specialised routine to get the next idl function in the buffer
+;;;
+;;; Lubos Pochman <lubos@rsinc.com>
+(defun fume-find-next-idl-function-name (buffer)
+"Searches for the next idl function in BUFFER."
+(set-buffer buffer)
+(if (re-search-forward (car fume-function-name-regexp-idl) nil t)
+(let ((beg (match-beginning (cdr fume-function-name-regexp-idl)))
+(end (match-end (cdr fume-function-name-regexp-idl))))
+(cons (buffer-substring beg end) beg))))
 ;;; Assembly
-;;; Bob Weiner <weiner@mot.com>
+;;; Bob Weiner <weiner@infodock.com>
 ;;;
 (defun fume-find-next-asm-function-name (buffer)
 "Searches for the next assembler function in BUFFER."
 (set-buffer buffer)
 ;; Search for the function
 (python-mode     . fume-find-next-python-function-name)
 (scheme-mode     . fume-find-next-scheme-function)
 (sgml-mode       . fume-find-next-sgml-element-name)
 (tcl-mode        . fume-match-find-next-function-name)
 (verilog-mode    . fume-find-next-verilog-function-name)
+(idl-mode        . fume-find-next-idl-function-name)
 )
 "The connection between a mode and the defun that finds function names.
 If no connection is in this alist for a given mode, a default method is used")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;  General utility functions  ;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Routine to refresh the modeline
+;;; modeline refresh routine
 ;;;
-(if (fboundp 'redraw-modeline)          ; faster built-in method
+(or (fboundp 'redraw-modeline)
-(defalias 'fume-refresh-modeline 'redraw-modeline)
+(defun redraw-modeline () (set-buffer-modified-p (buffer-modified-p))))
-(defun fume-refresh-modeline ()       ; use old kludge method
-(set-buffer-modified-p (buffer-modified-p))))
 ;;; Smart mouse positioning
 ;;;
 (if (fboundp 'window-edges)             ; old method
 (defun fume-set-mouse-position ()
 'fume-find-next-function-name)))
 fume-function-name-regexp)
 ;;; Routines to add/remove/update function menu from menubar
 ;;;
-(defsubst fume-add-menubar-entry ()
+(defun fume-add-menubar-entry ()
 (interactive)
 (save-window-excursion (function-menu t)))
-(defsubst fume-remove-menubar-entry ()
+(defun fume-remove-menubar-entry ()
 (interactive)
 (cond ((and fume-running-xemacs current-menubar)
 (delete-menu-item (list fume-menubar-menu-name))
 ;; force update of the menubar
-(fume-refresh-modeline))))
+(redraw-modeline))))
-(defsubst fume-update-menubar-entry ()
+(defun fume-update-menubar-entry ()
 "Returns t if menubar was updated. Nil otherwise"
 (and fume-running-xemacs
 fume-not-tty
 (assoc fume-menubar-menu-name current-menubar)
 (fume-add-menubar-entry)
 t))
-(defsubst fume-trim-string (string)
+(defun fume-trim-string (string)
 "Returns STRING with leading and trailing whitespace removed."
 (if (string-match "^[ \t]*" (setq string (format "%s" string)))
 (setq string (substring string (match-end 0))))
 (if (string-match "[ \t]*$" string)
 (setq string (substring string 0 (match-beginning 0))))
 string)
 (defvar fume-syntax-table nil)
-(defsubst fume-what-looking-at ()
+(defun fume-what-looking-at (&optional check-primary-selection-p)
-(let (name
+(or (and check-primary-selection-p
-(orig-syntax-table (copy-syntax-table (syntax-table))))
+primary-selection-extent
-(if fume-syntax-table
+(condition-case ()
-()
+(prog1 (buffer-substring (region-beginning) (region-end))
-(setq fume-syntax-table (copy-syntax-table))
+(and zmacs-regions (zmacs-deactivate-region) (sit-for 0)))
-(modify-syntax-entry ?: "w" fume-syntax-table))
+(error nil)))
-(unwind-protect
+(let (name
-(progn
+(orig-syntax-table (copy-syntax-table (syntax-table))))
-(set-syntax-table fume-syntax-table)
+(if fume-syntax-table
-(save-excursion
+()
-(while (looking-at "\\sw\\|\\s_") (forward-char 1))
+(setq fume-syntax-table (copy-syntax-table))
-(if (re-search-backward "\\sw\\|\\s_" nil t)
+(modify-syntax-entry ?: "w" fume-syntax-table))
-(let ((beg (progn (forward-char 1) (point))))
+(unwind-protect
-(forward-sexp -1)
+(progn
-(while (looking-at "\\s'") (forward-char 1))
+(set-syntax-table fume-syntax-table)
-(setq name (buffer-substring beg (point)))))))
+(save-excursion
-(set-syntax-table orig-syntax-table)
+(while (looking-at "\\sw\\|\\s_") (forward-char 1))
-name)))
+(if (re-search-backward "\\sw\\|\\s_" nil t)
+(let ((beg (progn (forward-char 1) (point))))
-;;; Find function name that point is in.
+(forward-sexp -1)
-;;; The trick is to start from the end...
+(while (looking-at "\\s'") (forward-char 1))
-;;;
+(setq name (buffer-substring beg (point)))))))
-(defsubst fume-function-before-point ()
+(set-syntax-table orig-syntax-table)
+name))))
+;;; Find function name that point is in
+;;; (trick is to start from the end)
+;;;
+(defun fume-function-before-point ()
 (if (or fume-modeline-funclist (fume-rescan-buffer) fume-modeline-funclist)
-(let (result
+(let ((p (point)))
-(pt (point)))
 (save-excursion
 (catch 'found
 (mapcar (function
-(lambda (p)
+(lambda (x)
-(goto-char (cdr p))
+(goto-char (cdr x))
 (beginning-of-line 1)
-(if (>= pt (point))
+(if (>= p (point)) (throw 'found (car x)))))
-(throw 'found (setq result (car p))))))
+fume-modeline-funclist) nil)))))
-fume-modeline-funclist))
-result))))
 ;;; Routines to add a buffer local post command hook
 ;;;
-(defsubst fume-post-command-hook-p (hook)
+(defun fume-post-command-hook-p (hook)
 (memq hook (if fume-use-local-post-command-hook
 local-post-command-hook
 post-command-hook)))
-(defsubst fume-add-post-command-hook (hook &optional append)
+(defun fume-add-post-command-hook (hook &optional append)
 (or (fume-post-command-hook-p hook)
 (cond (fume-use-local-post-command-hook
 (add-hook 'local-post-command-hook hook append))
 ((fboundp 'make-local-hook)
 (make-local-hook 'post-command-hook)
 (t
 ;; NOT make-variable-buffer-local
 (make-local-variable 'post-command-hook)
 (add-hook 'post-command-hook hook append)))))
-(defsubst fume-remove-post-command-hook (hook)
+(defun fume-remove-post-command-hook (hook)
 (and (fume-post-command-hook-p hook)
 (cond (fume-use-local-post-command-hook
 (remove-hook 'local-post-command-hook hook))
 ((fboundp 'make-local-hook)
 (remove-hook 'post-command-hook hook t))
 (t
 (remove-hook 'post-command-hook hook)))))
 ;;; Routine to install the modeline feature
 ;;;
-(defsubst fume-maybe-install-modeline-feature ()
+(defun fume-maybe-install-modeline-feature ()
 (cond ((and fume-display-in-modeline-p (fume-set-defaults))
 (or fume-modeline-funclist
 (fume-post-command-hook-p 'fume-tickle-modeline)
 (fume-rescan-buffer))
 (fume-add-post-command-hook 'fume-tickle-modeline)
 (t
 fume-modeline-buffer-identification-0))))
 (cond ((not fume-display-in-modeline-p)
 (fume-remove-post-command-hook 'fume-tickle-modeline)
 (fume-add-post-command-hook 'fume-maybe-install-modeline-feature)))
-;; force an update of the mode line
+;; force update of the modeline
-(fume-refresh-modeline))
+(redraw-modeline))
 (fume-defvar-local fume-modeline-buffer-identification-0 nil
 "Storage for original modeline-buffer-identification")
 (fume-defvar-local fume-modeline-buffer-identification-1 nil
 (mapcar (function (lambda (i) (cons (car i) (cdr i)))) list)))
 ;;; Sort function to sort items depending on their function-name
 ;;; An item looks like (NAME . POSITION).
 ;;;
-(defsubst fume-sort-by-name (item1 item2)
+(defun fume-sort-by-name (item1 item2)
 (or (string-lessp (car item1) (car item2))
 (string-equal (car item1) (car item2))))
 ;;; Sort function to sort items depending on their position
 ;;;
-(defsubst fume-sort-by-position (item1 item2)
+(defun fume-sort-by-position (item1 item2)
 (<= (cdr item1) (cdr item2)))
 ;;; Support function to calculate relative position in buffer
 ;;;
-(defsubst fume-relative-position ()
+(defun fume-relative-position ()
 (let ((pos (point))
 (total (buffer-size)))
 (if (> total 50000)
 ;; Avoid overflow from multiplying by 100!
 (/ (1- pos) (max (/ total 100) 1))
 (max total 1)))))
 ;;; Split LIST into sublists of max length N
 ;;; Example (fume-split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
 ;;;
-(defsubst fume-split (list n)
+(defun fume-split (list n)
 (let ((i 0)
 result
 sublist
 (remain list))
 (while remain
 (car (funcall find (current-buffer)))))))
 (error nil)))))
 (let ((fume-scanning-message nil))
 (fume-rescan-buffer))))))
-(defsubst fume-install-rescan-buffer-trigger ()
+(defun fume-install-rescan-buffer-trigger ()
 (cond ((not (fume-post-command-hook-p 'fume-rescan-buffer-trigger))
 (fume-add-post-command-hook 'fume-rescan-buffer-trigger 'append)
 ;; Make narrow-to-region tickle func-menu
 (or (fboundp 'fume-narrow-to-region)
 (fset 'fume-narrow-to-region
 (let ((fume-rescan-inhibit-p t))
 (fume-update-menubar-entry)))
 ;; Reset dirty flag
 (setq fume-funclist-dirty-p nil))
+(defun fume-scan-buffer ()
+(or fume-funclist (progn (fume-set-defaults) (fume-rescan-buffer))))
 ;;; Routine to position cursor
 ;;;
 (defun fume-goto-function (fn pos)
 "Position cursor at function FN at location POS"
 (let ((orig-pos (point))
 (call-interactively 'function-menu)))
 (error (select-window currwin)))))
 ;;; Interface for Key bindings
 ;;;
-(defun function-menu (&optional use-menubar)
+(defun function-menu (&optional use-menubar return-only)
 "Pop up a menu of functions for selection with the mouse.
+Jumps to the selected function.  A mark is set at the old position,
+so you can easily go back with C-u \\[set-mark-command].
 With a prefix arg adds the menu to the current menubar.
-Jumps to the selected function.  A mark is set at the old position,
+Optional second argument, RETURN-ONLY if non-nil simply returns
-so you can easily go back with C-u \\[set-mark-command]."
+the basic menu of functions."
 (interactive "P")
 (setq use-menubar
 (and use-menubar fume-running-xemacs fume-not-tty current-menubar))
 (fume-split fume-funclist fume-max-items))))
 (or (> count 1)
 (setq function-menu-items (cdr (car function-menu-items))))
-(setq function-menu
+(if return-only
-(` ((,@ function-menu-items)
+nil
-"----"
+(setq function-menu
-["Display full list of functions"
+(` ((,@ function-menu-items)
-fume-list-functions t]
-[(, (concat "Rescan buffer :  " (buffer-name)))
-(fume-rescan-buffer (, (null use-menubar))) t]
-"----"
-["Toggle modeline display"
-fume-toggle-modeline-display t]
-["Toggle buffer auto rescanning"
-fume-toggle-auto-rescanning t]
-["About Func-Menu" fume-about t])))
-(cond (use-menubar
-(fume-remove-menubar-entry)
-(set-buffer-menubar (copy-sequence current-menubar))
-(fume-add-submenu
-fume-menubar-menu-name
-(` ((,@ function-menu)
 "----"
-["Remove Function Menu from menubar"
+["Display full list of functions"
-fume-remove-menubar-entry t]))
+fume-list-functions t]
-fume-menubar-menu-location))
+[(, (concat "Rescan buffer :  " (buffer-name)))
+(fume-rescan-buffer (, (null use-menubar))) t]
-((and fume-not-tty   ; trap tty segmentation faults...
+"----"
-(not (popup-menu-up-p)))
+["Toggle modeline display"
-(or (fume-update-menubar-entry)
+fume-toggle-modeline-display t]
-(setq function-menu
+["Toggle buffer auto rescanning"
-(cons
+fume-toggle-auto-rescanning t]
-["Put Function Menu into menubar"
+["About Func-Menu" fume-about t])))
-(function-menu t) t]
-(cons "----" function-menu))))
+(cond (use-menubar
+(fume-remove-menubar-entry)
-(if fume-auto-position-popup
+(set-buffer-menubar (copy-sequence current-menubar))
-(fume-set-mouse-position))
+(fume-add-submenu
+fume-menubar-menu-name
-(popup-menu (cons "Functions" function-menu)))))))))
+(` ((,@ function-menu)
+"----"
+["Remove Function Menu from menubar"
+fume-remove-menubar-entry t]))
+fume-menubar-menu-location))
+((and fume-not-tty ; trap tty segmentation faults...
+(not (popup-menu-up-p)))
+(or (fume-update-menubar-entry)
+(setq function-menu
+(cons
+["Put Function Menu into menubar"
+(function-menu t) t]
+(cons "----" function-menu))))
+(if fume-auto-position-popup
+(fume-set-mouse-position))
+(popup-menu
+(cons fume-menubar-menu-name function-menu)))))
+;; Return basic function menu for display by another function
+function-menu-items)))))
 (defun fume-mouse-function-goto (event)
 "Goto function clicked on or prompt in minibuffer (with completion)."
 (interactive "@e")
-(goto-char (event-point event))
+(let ((orig-pos (point)))
-(let ((fume-no-prompt-on-valid-default t))
+(goto-char (event-point event))
-(fume-prompt-function-goto)))
+(let ((fume-no-prompt-on-valid-default t))
+(fume-prompt-function-goto))
+(or (= orig-pos (point))
+(push-mark orig-pos (null fume-scanning-message)))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;  Keyboard access to func-menu for tty users  ;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 (defun fume-prompt-function-goto (&optional other-window-p)
 "Goto function prompted for in minibuffer (with completion).
 With prefix arg, jumps to function in a different window."
 (interactive "P")
-(and (interactive-p) current-prefix-arg (setq other-window-p t))
+(let* ((default-name (fume-what-looking-at t))
-(let* ((default-name (fume-what-looking-at))
 (OrigBuffer (current-buffer))
-(TargetBuffer
+(flistMode (eq major-mode 'fume-list-mode))
-(if (eq major-mode 'fume-list-mode) fume-list-srcbuffer OrigBuffer))
+(no-prompt (or flistMode fume-no-prompt-on-valid-default))
-(fume-no-prompt-on-valid-default
+(TargetBuffer (if flistMode fume-list-srcbuffer OrigBuffer)))
-(or fume-no-prompt-on-valid-default
-(eq major-mode 'fume-list-mode))))
 (switch-to-buffer TargetBuffer)
-;; Create funclist and set defaults
+(fume-scan-buffer) ;; Create funclist and set defaults if required
-(cond ((null fume-funclist)
-(fume-set-defaults)
-(fume-rescan-buffer)))
 (let* (;; verify default-name is a valid function name
 (default-exists-p (assoc default-name fume-funclist))
 ;; Prompt for function name in minibuffer, unless there is a valid
 ;; function name at point & fume-no-prompt-on-valid-default set to t
 (function-name
-(if (and default-exists-p
+(if (and default-exists-p no-prompt)
-fume-no-prompt-on-valid-default)
 ""
-(completing-read
+(let ((this-command last-command)) ; preserve last-command
-(format "Goto function%s%s: "
+(completing-read
-(if other-window-p " other window" "")
+(format "Goto function%s%s: "
-(if default-exists-p
+(if other-window-p " other window" "")
-(concat " (" default-name ")")
+(if default-exists-p
-""))
+(concat " (" default-name ")")
-fume-funclist nil t)))
+""))
+fume-funclist nil t))))
 ;; Use default function name if just RET was pressed
 (function-name (if (and default-exists-p (string= "" function-name))
 default-name
 function-name)))
 (switch-to-buffer OrigBuffer)
 ;; Goto function or just return if function name is empty string
 (cond ((not (string= "" function-name))
 (if other-window-p
 (cond ((prog1 (one-window-p)
-(switch-to-buffer-other-window TargetBuffer))
+(if (not (windowp other-window-p))
+(switch-to-buffer-other-window TargetBuffer)
+(select-window other-window-p)
+(switch-to-buffer TargetBuffer)))
 (other-window 1)
 (shrink-window-if-larger-than-buffer)
 (other-window 1)))
 (switch-to-buffer TargetBuffer))
 (fume-goto-function
 (delete-other-windows)
 (fume-prompt-function-goto))
 (defun fume-prompt-function-goto-other-window ()
 (interactive)
-(let ((current-prefix-arg 1))
+(fume-prompt-function-goto t))
-(call-interactively 'fume-prompt-function-goto)))
+(defun fume-list-functions-show-fn-other-window (&optional window)
-(defun fume-list-functions-show-fn-other-window ()
 (interactive)
 (beginning-of-line)
 (select-window
-(prog1 (selected-window)
+(prog1 (selected-window) (fume-prompt-function-goto (or window t)))))
-(fume-prompt-function-goto-other-window))))
+(defun fume-list-functions-show-prev-fn-other-window (&optional window)
-(defun fume-list-functions-show-prev-fn-other-window ()
 (interactive)
 (forward-line -1)
-(fume-list-functions-show-fn-other-window))
+(fume-list-functions-show-fn-other-window window))
-(defun fume-list-functions-show-next-fn-other-window ()
+(defun fume-list-functions-show-next-fn-other-window (&optional window)
 (interactive)
 (forward-line 1)
 (beginning-of-line)
-(fume-list-functions-show-fn-other-window))
+(fume-list-functions-show-fn-other-window window))
 (defun fume-list-functions-help ()
 (interactive)
 (fume-about)
 (sit-for 1)
 (defvar fume-list-mode-hook nil "*Hook to run after fume-list-mode entered")
 (defun fume-list-functions (&optional this-window)
 "Creates a temporary buffer listing functions found in the current buffer"
 (interactive "P")
+(fume-scan-buffer) ;; Create funclist and set defaults if required
 (let ((func-near-point (format "^%s$" (fume-function-before-point))))
 (cond ((or fume-function-name-regexp (fume-maybe-install-modeline-feature))
 (save-excursion
 (let ((srcbuffer (current-buffer)))
 (set-buffer (get-buffer-create fume-buffer-name))
 (fume-list-functions-help))))
 (t
 (error "Func-Menu is not operative in this buffer")))))
 (provide 'func-menu)
+;;; end of file

Mercurial > hg > xemacs-beta

comparison lisp/packages/func-menu.el @ 82:6a378aca36af r20-0b91