comparison lisp/packages/func-menu.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; func-menu.el --- Jump to a function within a buffer.
2 ;;;
3 ;;; David Hughes <ukchugd@ukpmr.cs.philips.nl>
4 ;;; Last modified: David Hughes 2nd May 1996
5 ;;; Version: 2.43
6 ;;; Keywords: tools, c, lisp
7 ;;;
8 ;;; This program is free software; you can redistribute it and/or modify
9 ;;; it under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 2, or (at your option)
11 ;;; any later version.
12 ;;;
13 ;;; This program is distributed in the hope that it will be useful,
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with this program; if not, write to the Free Software
20 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 ;;;
22 ;;; Synched up with: Not in FSF.
23 ;;;
24 ;;; Installation:
25 ;;; =============
26 ;;; (require 'func-menu)
27 ;;; (define-key global-map 'f8 'function-menu)
28 ;;; (add-hook 'find-file-hooks 'fume-add-menubar-entry)
29 ;;; (define-key global-map "\C-cl" 'fume-list-functions)
30 ;;; (define-key global-map "\C-cg" 'fume-prompt-function-goto)
31 ;;; (define-key global-map '(shift button3) 'mouse-function-menu)
32 ;;; (define-key global-map '(meta button1) 'fume-mouse-function-goto)
33 ;;;
34 ;;; Description:
35 ;;; ============
36 ;;; Suppose you have a file with a lot of functions in it. Well, this package
37 ;;; makes it easy to jump to any of those functions. The names of the
38 ;;; functions in the current buffer are automatically put into a popup menu,
39 ;;; you select one of the function-names and the point is moved to that very
40 ;;; function. The mark is pushed on the mark-ring, so you can easily go back
41 ;;; to where you were. Alternatively, you can use enter the name of the
42 ;;; desired function via the minibuffer which offers completing read input. In
43 ;;; addition, the name of the function before point is optionally displayed in
44 ;;; the modeline.
45 ;;;
46 ;;; Support for non X Windows versions of Emacs:
47 ;;; ============================================
48 ;;; This package can also be used for non X versions of Emacs. In this case,
49 ;;; only modeline display and completing read input from the minibuffer are
50 ;;; possible.
51 ;;;
52 ;;; Modes supported:
53 ;;; ================
54 ;;; Ada, Assembly, Bacis2, BibTex, C++, C, Dired, Ehdm, ELisp, FORTRAN, Ksh,
55 ;;; Latex, Lelisp, Makefile, Maple, Modula2, Modula3, Outline, Pascal, Perl,
56 ;;; Postscript, Prolog, PVS, Python, SGML, Scheme, Tcl, Verilog
57 ;;;
58 ;;; Acknowledgements:
59 ;;; =================
60 ;;;
61 ;;; Fortran90 regexp
62 ;;; John Turner <turner@xdiv.lanl.gov>
63 ;;;
64 ;;; Patch to error trap in fume-rescan-buffer
65 ;;; Andy Piper <andyp@parallax.co.uk>
66 ;;;
67 ;;; Java support
68 ;;; Heddy Boubaker <boubaker@dgac.fr>
69 ;;;
70 ;;; Patch for fume-rescan-buffer{-trigger}
71 ;;; Christoph Wedler <wedler@vivaldi.fmi.uni-passau.de>
72 ;;;
73 ;;; Patch for fume-tickle-f-to-b
74 ;;; Michael Sperber <sperber@informatik.uni-tuebingen.de>
75 ;;;
76 ;;; Cleanup suggestions
77 ;;; Jonathan Stigelman <stig@hackvan.com>
78 ;;;
79 ;;; Idea for jumping directly with a mouse click
80 ;;; Marc Paquette <Marc.Paquette@Softimage.COM>
81 ;;;
82 ;;; Prolog mode additions based on functions for Postscript mode
83 ;;; Laszlo Teleki <laszlo@ipb.uni-bonn.de>
84 ;;;
85 ;;; Idea for displaying function name in modeline
86 ;;; Paul Filipski <filipski@blackhawk.com>
87 ;;;
88 ;;; Fame mode support
89 ;;; Cooper Vertz <cooper@prod2.imsi.com>
90 ;;;
91 ;;; Made fume-match-find-next-function-name iterative, not recursive, to avoid
92 ;;; blowing out the emacs stack on big files with lots of prototypes.
93 ;;; Joe Marshall <jrm@odi.com>
94 ;;;
95 ;;; Verilog support
96 ;;; Matt Sale <mdsale@icdc.delcoelect.com>
97 ;;;
98 ;;; Minibuffer interface & Pascal support
99 ;;; Espen Skoglund <espensk@stud.cs.uit.no>
100 ;;;
101 ;;; Python support
102 ;;; Shuichi Koga <skoga@virginia.edu>
103 ;;;
104 ;;; Maple support
105 ;;; Luc Tancredi <Luc.Tancredi@sophia.inria.fr>
106 ;;;
107 ;;; Combined Tcl and C++ function finder
108 ;;; Andy Piper <ajp@eng.cam.ac.uk>
109 ;;;
110 ;;; Perl Support
111 ;;; Alex Rezinsky <alexr@msil.sps.mot.com>
112 ;;; Michael Lamoureux <lamour@engin.umich.edu>
113 ;;;
114 ;;; Suggested mouse interface
115 ;;; Raymond L. Toy <toy@soho.crd.ge.com>
116 ;;;
117 ;;; Dired support
118 ;;; Improved modula support
119 ;;; Numerous code cleanups
120 ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
121 ;;;
122 ;;; Makefile support
123 ;;; Suggested multi-choice sublisting
124 ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
125 ;;;
126 ;;; Suggestions for menubar entry
127 ;;; Andy Piper <ajp@eng.cam.ac.uk>
128 ;;;
129 ;;; Ada support
130 ;;; Scott Evans <gse@ocsystems.com>
131 ;;; Michael Polo <mikep@polo.mn.org> <mikep@cfsmo.honeywell.com>
132 ;;;
133 ;;; Scheme, BibTeX, Ehdm & PVS support
134 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
135 ;;;
136 ;;; Modula support
137 ;;; Geoffrey Wyant <gwyant@cloyd.east.sun.com>
138 ;;;
139 ;;; SGML support; submenu indexing
140 ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
141 ;;;
142 ;;; Extensions to fume-function-name-regexp-lisp
143 ;;; Kari Heinola <kph@dpe.fi>
144 ;;; Milo A. Chan <chan@jpmorgan.com>
145 ;;; Jack Repenning <jackr@step7.informix.com>
146 ;;; Cedric Beust <Cedric.Beust@sophia.inria.fr>
147 ;;; Joachim Krumnow <krumnow@srsir02.ext.sap-ag.de>
148 ;;;
149 ;;; ksh support
150 ;;; Philippe Bondono <bondono@vnet.ibm.com>
151 ;;;
152 ;;; FORTRAN support
153 ;;; Paul Emsley <paule@chem.gla.ac.uk>
154 ;;; Raymond L. Toy <toy@soho.crd.ge.com>
155 ;;; Richard Cognot <cognot@elfgrc.co.uk>
156 ;;; Greg Sjaardema <gdsjaar@sandia.gov>
157 ;;;
158 ;;; Latex support
159 ;;; Wolfgang Mettbach <wolle@uni-paderborn.de>
160 ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
161 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
162 ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
163 ;;;
164 ;;; Assembly support
165 ;;; Bob Weiner <weiner@mot.com>
166 ;;;
167 ;;; Removal of cl dependencies
168 ;;; Russell Ritchie <russell@gssec.bt.co.uk>
169 ;;;
170 ;;; C++ mode enhancemencements for func-menu
171 ;;; Andy Piper <ajp@eng.cam.ac.uk>
172 ;;; Kevin R. Powell <powell@csl.ncsa.uiuc.edu>
173 ;;; Mats Lidell <mats.lidell@eua.ericsson.se>
174 ;;; Mike Battaglia <mbattagl@spd.dsccc.com>
175 ;;; Oliver Schittko <schittko@fokus.gmd.de>
176 ;;; Tom Murray <tmurray@hpindck.cup.hp.com>
177 ;;; Russell Ritchie <russell@gssec.bt.co.uk>
178 ;;;
179 ;;; Tcl mode additions for func-menu
180 ;;; Andy Piper <ajp@eng.cam.ac.uk>
181 ;;; Jean-Michel Augusto <augusto@eurecom.fr>
182 ;;; Dr P.G. Sjoerdsma <pgs1002@esc.cam.ac.uk>
183 ;;;
184 ;;; Postscript mode additions for func-menu
185 ;;; Leigh Klotz <klotz@adoc.xerox.com>
186 ;;;
187 ;;; Suggestions for popup menu positioning
188 ;;; Marc Gemis <makke@wins.uia.ac.be>
189 ;;;
190 ;;; Original FSF package
191 ;;; Ake Stenhoff <etxaksf@aom.ericsson.se>
192
193 ;;; Code
194
195 (eval-when-compile
196 (byte-compiler-options
197 (optimize t)
198 (new-bytecodes t)
199 (warnings (- free-vars unresolved))))
200
201 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
202 ;;;;;;;;;;;;;;;;;;;;;;;; Environment Initialisation ;;;;;;;;;;;;;;;;;;;;;;
203 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
204
205 (defconst fume-version "2.43")
206
207 (defconst fume-developer "David Hughes <ukchugd@ukpmr.cs.philips.nl>")
208
209 (defun fume-about ()
210 (interactive)
211 (sit-for 0)
212 (message "Func-Menu version %s, ¨ 1996 %s" fume-version fume-developer))
213
214 (defconst fume-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
215
216 (defmacro fume-defvar-local (var value &optional doc)
217 "Defines SYMBOL as an advertised variable.
218 Performs a defvar, then executes `make-variable-buffer-local' on
219 the variable. Also sets the `permanent-local' property, so that
220 `kill-all-local-variables' (called by major-mode setting commands)
221 won't destroy func-menu control variables."
222 (` (progn
223 (if (, doc)
224 (defvar (, var) (, value) (, doc))
225 (defvar (, var) (, value)))
226 (make-variable-buffer-local '(, var))
227 (put '(, var) 'permanent-local t))))
228
229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
230 ;;;;;;;; Backward compatibility hacks for older versions of XEmacs ;;;;;;;
231 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
232
233 (or (fboundp 'defalias)
234 ;; poor man's defalias
235 (defun defalias (sym newdef)
236 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
237 Associates the function with the current load file, if any."
238 (fset sym (symbol-function newdef))))
239
240 (or (fboundp 'selected-frame)
241 (defalias 'selected-frame 'selected-screen))
242
243 (if (fboundp 'locate-window-from-coordinates)
244 ;; Older versions of XEmacs need a more robust version of 'event-window'
245 (defun fume-event-window (event)
246 (or (event-window event)
247 (locate-window-from-coordinates
248 (selected-frame) (list (event-x event) (event-y event)))
249 (locate-window-from-coordinates
250 (selected-frame) (list (event-x event) (1- (event-y event))))))
251 ;; In post 19.11 versions of XEmacs 'event-window' now works acceptably
252 (defalias 'fume-event-window 'event-window))
253
254 (or (fboundp 'shrink-window-if-larger-than-buffer)
255 ;; Win-Emacs doesn't have this goodie
256 (defun shrink-window-if-larger-than-buffer (&optional window reqd-height)
257 "Shrink WINDOW to the smallest no of lines needed to display its buffer,
258 or to optional REQUIRED-HEIGHT if and only if that is larger. Does nothing if
259 the buffer contains more lines than the present window height."
260 (interactive)
261 (let* ((OriginalWindow (selected-window))
262 (TargetWindow (select-window (or window OriginalWindow))))
263 (or (one-window-p t)
264 (and reqd-height (>= reqd-height (window-height)))
265 (< (window-height) (1+ (count-lines (point-min) (point-max))))
266 (let ((calc-reqd-height
267 (if truncate-lines
268 (1+ (count-lines (point-min) (point-max)))
269 (save-excursion
270 (let ((count 0)
271 linew
272 (windw (window-width)))
273 (goto-char (point-min))
274 (while (not (eobp))
275 (setq linew (1+ (progn (end-of-line)
276 (current-column)))
277 count (+ count
278 (/ linew windw)
279 (min (% linew windw) 1)))
280 (beginning-of-line 2))
281 count)))))
282 (setq reqd-height (1+ (max calc-reqd-height
283 (1- window-min-height)
284 (or reqd-height 0))))
285 (if (> (window-height) reqd-height)
286 (let* (wc spare bonus share wins shrunkwins)
287 (walk-windows
288 '(lambda (w)
289 (select-window w)
290 (if (or (eq w TargetWindow)
291 (> (1+ (count-lines (point-min) (point-max)))
292 (1- (window-height w))))
293 (setq wins (cons w wins))
294 (if (= (1+ (count-lines (point-min) (point-max)))
295 (1- (window-height w)))
296 (setq shrunkwins (cons w shrunkwins)))))
297 'nomini)
298 (setq wc (1- (length wins))
299 spare (- (window-height TargetWindow) reqd-height)
300 share (if (> wc 0) (/ spare wc))
301 bonus (if (> wc 0) (% spare wc))
302 shrunkwins (if (zerop wc) nil shrunkwins)
303 wins (mapcar (function
304 (lambda (w)
305 (cons w (list
306 (if (eq w TargetWindow)
307 reqd-height
308 (+ (window-height w)
309 share
310 (if (zerop bonus)
311 0
312 (setq bonus
313 (1- bonus))
314 1)))
315 (window-start w)))))
316 wins))
317 (let (ok (trys 2))
318 (while (and (not ok) (> trys 0))
319 (setq trys (1- trys))
320 (mapcar
321 (function
322 (lambda (info)
323 (select-window (car info))
324 (enlarge-window
325 (- (car (cdr info)) (window-height)))))
326 wins)
327 (setq ok t)
328 (mapcar
329 (function
330 (lambda (info)
331 (setq ok
332 (and ok
333 (<= (abs (- (car (cdr info))
334 (window-height
335 (car info))))
336 1)))))
337 wins)))
338 (mapcar
339 (function
340 (lambda (info)
341 (select-window (car info))
342 (if (eq (car info) TargetWindow)
343 (shrink-window
344 (- (window-height TargetWindow) reqd-height)))
345 (set-window-start (car info) (car (cdr (cdr info))))))
346 wins)
347 (mapcar
348 (function
349 (lambda (w)
350 (select-window w)
351 (if (< (1+ (count-lines (point-min) (point-max)))
352 (1- (window-height w)))
353 (shrink-window-if-larger-than-buffer))))
354 shrunkwins)))))
355 (select-window OriginalWindow))))
356
357 (defconst fume-modeline-buffer-identification
358 (if (boundp 'modeline-buffer-identification)
359 'modeline-buffer-identification
360 'mode-line-buffer-identification))
361
362 (defconst fume-use-local-post-command-hook
363 (boundp 'local-post-command-hook))
364
365 (cond ((fboundp 'add-submenu)
366 (defconst fume-add-submenu 'add-submenu)
367 (defun fume-munge-menu-args (menu-name submenu before)
368 (list nil (cons menu-name submenu) before)))
369 (t
370 (defconst fume-add-submenu 'add-menu)
371 (defun fume-munge-menu-args (menu-name submenu before)
372 (list nil menu-name submenu before))))
373
374 (defun fume-add-submenu (menu-name submenu before)
375 (apply fume-add-submenu (fume-munge-menu-args menu-name submenu before)))
376
377 (defconst fume-not-tty
378 (or (and (fboundp 'device-type) (not (eq 'tty (device-type))))
379 (and (symbol-value 'window-system) t))) ; obsolete test
380
381 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
382 ;;;;;;;;;;;;;;;;;;;;;;;;;; Customizable Variables ;;;;;;;;;;;;;;;;;;;;;;;;
383 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
384
385 (defvar fume-auto-position-popup t
386 "*Set to nil if you don't want the menu to appear in the corner of the window
387 in which case it will track the mouse position instead.")
388
389 (fume-defvar-local fume-display-in-modeline-p t
390 "*Set to nil if you don't want the function name appearing in the modeline.
391 If your modeline is already full, then you can set this variable to something
392 besides nil or t and the current function will replace the normal
393 modeline-buffer-identification
394
395 Note, this is a buffer-local variable.")
396
397 (defvar fume-buffer-name "*Function List*"
398 "Name of buffer used to list functions when fume-list-functions called")
399
400 (fume-defvar-local
401 fume-menubar-menu-name "Functions"
402 "*Set this to the string you want to appear in the menubar")
403
404 (defvar fume-menubar-menu-location "Buffers"
405 "*Set this nil if you want the menu to appear last on the menubar.
406 Otherwise set this to the menu you want \"Functions\" to appear in front of.")
407
408 (defvar fume-max-items 24
409 "*Maximum number of elements in a function (sub)menu.")
410
411 (defvar fume-fn-window-position 3
412 "*Number of lines from top of window at which to show function.
413 If nil, display function start from the centre of the window.")
414
415 (defvar fume-index-method 3
416 "*Set this to the method number you want used.
417
418 Methods currently supported:
419 0 = if you want submenu names to be numbered
420 1 = if you want submenu range indicated by first character
421 2 = if you want submenu range indicated by first 12 characters
422 3 = if you want submenu range indicated by as many characters as needed")
423
424 (defvar fume-scanning-message "Scanning buffer... (%3d%%)"
425 "*Set to nil if you don't want progress messages during manual scanning
426 of the buffer.")
427
428 (defvar fume-rescanning-message nil
429 "*Set to non-nil if you want progress messages during automatic scanning
430 of the buffer. For example \"Re-Scanning buffer...\"")
431
432 (defvar fume-rescan-trigger-counter-buffer-size 10000
433 "Used to tune the frequency of automatic checks on the buffer.
434 The function fume-rescan-buffer-trigger only works whenever the value of the
435 variable fume-rescan-trigger-counter reaches zero, whereupon it gets reset to
436 buffer-size/fume-rescan-trigger-counter-buffer-size.")
437
438 (fume-defvar-local
439 fume-sort-function 'fume-sort-by-name
440 "*The function to use for sorting the function menu.
441
442 Set this to nil if you don't want any sorting (faster).
443 The items in the menu are then presented in the order they were found
444 in the buffer.
445
446 The function should take two arguments and return T if the first
447 element should come before the second. The arguments are cons cells;
448 (NAME . POSITION). Look at 'fume-sort-by-name' for an example.")
449
450 (fume-defvar-local
451 fume-rescan-buffer-hook nil
452 "*Buffer local hook to call at the end of each buffer rescan")
453
454 ;;; This hook is provided for outl-mouse and must not be made buffer local as
455 ;;; this appears to break outl-mouse for some reason.
456 ;;;
457 (defvar fume-found-function-hook nil
458 "*Hook to call after every function match.")
459
460 ;;; Idea for jumping directly with a mouse click
461 ;;; Marc Paquette <Marc.Paquette@Softimage.COM>
462 ;;;
463 (defvar fume-no-prompt-on-valid-default nil
464 "*Set non-nil if 'fume-prompt-function-goto' should jump without prompting
465 when a valid default exists.")
466
467 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
468 ;;;;;;;;;;;;;;;;;;;;;;;;;; Buffer local variables ;;;;;;;;;;;;;;;;;;;;;;;;
469 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
470
471 (fume-defvar-local
472 fume-auto-rescan-buffer-p t
473 "Buffer local variable which if non-nil permits automatic buffer rescanning
474 by func-menu.
475
476 Usage:
477 By default, fume-auto-rescan-buffer-p is set to non-nil. If you feel that
478 a given mode 'foo' is becoming too slow as a result of automatic rescanning
479 by func-menu, then do something along the lines of the following:
480
481 (defun remove-func-menu-auto-rescan ()
482 (setq fume-auto-rescan-buffer-p nil))
483
484 (add-hook 'foo-mode-hook 'remove-func-menu-auto-rescan)")
485
486 (fume-defvar-local
487 fume-funclist nil
488 "The latest list of function names in the buffer")
489
490 (fume-defvar-local
491 fume-function-name-regexp nil
492 "The keywords to show in a menu")
493
494 (fume-defvar-local
495 fume-find-next-function-name-method nil
496 "The function to use to find the next function name in the buffer")
497
498 (fume-defvar-local
499 fume-modeline-funclist nil
500 "The latest list of function names in the buffer to display in the modeline")
501
502 (fume-defvar-local
503 fume-funclist-dirty-p nil
504 "Flags whether the buffer is in need of a fresh scan")
505
506 (fume-defvar-local
507 fume-rescan-inhibit-p nil
508 "Internal variable only. DO NOT TOUCH.")
509
510 (fume-defvar-local
511 fume-rescan-trigger-counter 0
512 "Used in large buffers to optimise checking frequency")
513
514 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
515 ;;;;;;;;;;;;;;;;;;;;; Mode specific regexp's and hooks ;;;;;;;;;;;;;;;;;;;
516 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
517
518 ;;; Every fume-function-name-regexp-<language> should uniquely identify a
519 ;;; function for that certain language.
520
521 ;;; Lisp
522 ;;;
523 ;;; Jack Repenning <jackr@step7.informix.com>
524 ;;; Cedric Beust <Cedric.Beust@sophia.inria.fr>
525 (defvar fume-function-name-regexp-lisp
526 (concat
527 "\\(^(defun+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
528 "\\|"
529 "\\(^(defsubst+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
530 "\\|"
531 "\\(^(defmacro+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
532 "\\|"
533 "\\(^(defadvice+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
534 "\\|"
535 "\\(^(de+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
536 "\\|"
537 "\\(^(dmd+\\s-*[#:?A-Za-z0-9_+->]+\\s-*(\\)"
538 )
539 "Expression to get lisp function names")
540
541 ;;; C
542 ;;;
543 ;;; Danny Bar-Dov <danny@acet02.amil.co.il>
544 (defvar fume-function-name-regexp-c
545 (concat
546 "^[a-zA-Z0-9]+\\s-?" ; type specs; there can be no
547 "\\([a-zA-Z0-9_*]+\\s-+\\)?" ; more than 3 tokens, right?
548 "\\([a-zA-Z0-9_*]+\\s-+\\)?"
549 "\\([*&]+\\s-*\\)?" ; pointer
550 "\\([a-zA-Z0-9_*]+\\)[ \t\n]*(" ; name
551 )
552 "Expression to get C function names")
553
554 ;;; C++
555 ;;;
556 ;;; Andy Piper <ajp@eng.cam.ac.uk>
557 ;;; Kevin R. Powell <powell@csl.ncsa.uiuc.edu>
558 ;;; Mats Lidell <mats.lidell@eua.ericsson.se>
559 ;;; Mike Battaglia <mbattagl@spd.dsccc.com>
560 ;;; Oliver Schittko <schittko@fokus.gmd.de>
561 ;;; Tom Murray <tmurray@hpindck.cup.hp.com>
562 (defvar fume-function-name-regexp-c++
563 (cons
564 (concat
565 "^\\(template\\s +<[^>]+>\\s +\\)?" ; template formals
566 "\\([a-zA-Z0-9_*&<,>:]+\\s-+\\)?" ; type specs; there can be no
567 "\\([a-zA-Z0-9_*&<,>\"]+\\s-+\\)?" ; more than 3 tokens, right?
568 "\\([a-zA-Z0-9_*&<,>]+\\s-+\\)?"
569 "\\(\\([a-zA-Z0-9_&~:<,>*]\\|\\(\\s +::\\s +\\)\\)+\\)"
570 "\\(o?perator\\s *.[^(]*\\)?\\(\\s-\\|\n\\)*(" ; name
571 ) 5)
572 "Expression to get C++ function names")
573
574 ;;; FORTRAN
575 ;;;
576 ;;; Paul Emsley <paule@chem.gla.ac.uk>
577 ;;; Raymond L. Toy <toy@soho.crd.ge.com>
578 ;;; Richard Cognot <cognot@elfgrc.co.uk>
579 ;;; Greg Sjaardema <gdsjaar@sandia.gov>
580 (defvar fume-function-name-regexp-fortran
581 (concat
582 ;; >= six spaces
583 "^ \\s-*"
584 ;; type specs
585 "+[a-zA-Z0-9*]*\\s-*"
586 ;; continuation lines
587 "\\(\n [^ 0]\\s-*\\)*"
588 ;; function or subroutine
589 "\\(entry\\|ENTRY\\|function\\|FUNCTION\\|subroutine\\|SUBROUTINE\\)\\s-*"
590 ;; continuation lines
591 "\\(\n [^ 0]\\s-*\\)*"
592 )
593 "Expression to get Fortran 77 function and subroutine names")
594
595 ;;; John Turner <turner@xdiv.lanl.gov>
596 (defvar fume-function-name-regexp-fortran90
597 (concat
598 ;; type specs
599 "+[a-zA-Z0-9*]*\\s-*"
600 ;; function or subroutine
601 "\\(entry\\|ENTRY\\|function\\|FUNCTION\\|module\\|MODULE\\|subroutine\\|SUBROUTINE\\)\\s-*"
602 )
603 "Expression to get Fortran 90 function, module and subroutine names")
604
605 ;;; Modula
606 (defvar fume-function-name-regexp-modula
607 "^\\s-*PROCEDURE\\s-+[A-Za-z0-9_-]+"
608 "Expression to get Modula function names")
609
610 ;;; Bacis2
611 ;;;
612 ;;; CV MEDUSA's 4th generation language
613 (defvar fume-function-name-regexp-bacis
614 "module_define(!\\|define_constant(!\\|sys_sysdefine(!\\|<<dbgid +\\s-*"
615 "Expression to get Bacis2 function names")
616
617 ;;; Maple
618 ;;;
619 ;;; Luc Tancredi <Luc.Tancredi@sophia.inria.fr>
620 (defvar fume-function-name-regexp-maple
621 "^[ \t]*[a-zA-Z0-9_]+[ \t]*:=[ \t]*proc[ \t]*("
622 "Expression to get maple function/procedure names")
623
624 ;;; Tcl
625 ;;;
626 ;;; Andy Piper <ajp@eng.cam.ac.uk>
627 ;;; Jean-Michel Augusto <augusto@eureecom.fr>
628 ;;; Dr P.G. Sjoerdsma <pgs1002@esc.cam.ac.uk>
629 (defvar fume-function-name-regexp-tcl
630 (cons "^\\s *proc\\s +\\(\\S-+\\)\\s *{" 1)
631 "Expression to get Tcl function Names")
632
633 ;;; Java
634 ;;;
635 ;;; Heddy Boubaker <boubaker@dgac.fr>
636 (defvar fume-function-name-regexp-java
637 "\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)[\n \t\r]*\\((\\)"
638 "Expression to get Java methods names")
639
640 ;;; Perl
641 ;;;
642 ;;; Alex Rezinsky <alexr@msil.sps.mot.com>
643 ;;; Michael Lamoureux <lamour@engin.umich.edu>
644 (defvar fume-function-name-regexp-perl "^sub[ \t]+\\([A-Za-z0-9_]+\\)"
645 "Expression to get Perl function Names")
646
647 ;;; Python support
648 ;;; Shuichi Koga <skoga@virginia.edu>
649 ;;;
650 (defvar fume-function-name-regexp-python
651 "^\\s-*\\(class\\|def\\)+\\s-*\\([A-Za-z0-9_]+\\)\\s-*[(:]"
652 "Expression to get Python class and function names")
653
654 ;;; Postscript
655 ;;;
656 ;;; Leigh L. Klotz <klotz@adoc.xerox.com>
657 (defvar fume-function-name-regexp-postscript
658 "^/[^][ \t{}<>]*"
659 "Expression to get postscript function names")
660
661 ;;; Prolog
662 ;;;
663 ;;; Laszlo Teleki <laszlo@ipb.uni-bonn.de>
664 (defvar fume-function-name-regexp-prolog
665 "^[a-z][a-zA-Z0-9_]+"
666 "Expression to get prolog fact and clause names")
667
668 ;;; Ehdm
669 ;;;
670 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
671 (defvar fume-function-name-regexp-ehdm
672 (concat
673 "[A-Za-z0-9_]*:[ ]*"
674 "\\([Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|"
675 "[Ll][Ee][Mm][Mm][Aa]\\|"
676 "[Aa][Xx][Ii][Oo][Mm]\\|"
677 "[Pp][Rr][Oo][Vv][Ee]\\|"
678 "[Tt][Hh][Ee][Oo][Rr][Ee][Mm]"
679 "\\)"
680 )
681 "*Expression to get Ehdm function, theorems, axioms, lemmas, and proofs.")
682
683 ;;; PVS
684 ;;;
685 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
686 (defvar fume-function-name-regexp-pvs
687 (concat
688 "\\([A-Za-z0-9_]*:[ ]*"
689 "\\([Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|"
690 "[Ll][Ee][Mm][Mm][Aa]\\|"
691 "[Aa][Xx][Ii][Oo][Mm]\\|"
692 "[Tt][Hh][Ee][Oo][Rr][Ee][Mm]\\|"
693 "[Ff][Or][Rr][Mm][Uu][La][Aa]"
694 "\\|"
695 "\\[.*\\]"
696 "\\)\\)\\|"
697 "[A-Za-z0-9_]*(.*)[ ]*:"
698 )
699 "*Expression to get PVS functions, theorems, axioms, lemmas")
700
701 ;;; Tex, LaTex
702 ;;;
703 ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
704 ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
705 (fume-defvar-local fume-tex-chapter 0)
706 (fume-defvar-local fume-tex-section 0)
707 (fume-defvar-local fume-tex-subsection 0)
708 (fume-defvar-local fume-tex-subsubsection 0)
709
710 (defun fume-tex-rescan-buffer-hook ()
711 (setq fume-tex-chapter 0
712 fume-tex-section 0
713 fume-tex-subsection 0
714 fume-tex-subsubsection 0))
715
716 (defun fume-tweak-tex-mode ()
717 (setq fume-sort-function nil)
718 (add-hook 'fume-rescan-buffer-hook 'fume-tex-rescan-buffer-hook))
719
720 (add-hook 'tex-mode-hook 'fume-tweak-tex-mode)
721 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
722 (add-hook 'TeX-mode-hook 'fume-tweak-tex-mode)
723 ;;; Wolfgang Mettbach <wolle@uni-paderborn.de>
724 (add-hook 'latex-mode-hook 'fume-tweak-tex-mode)
725 (add-hook 'LaTeX-mode-hook 'fume-tweak-tex-mode)
726
727 ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
728 (defvar fume-section-name-regexp-latex
729 (concat
730 "^\\s-*\\\\\\("
731 "\\(sub\\)*section\\|chapter\\)"
732 "\\*?\\(\\[[^]]*\\]\\)?{\\([^}]*\\)}"
733 )
734 "Expression to get latex section names")
735
736 ;;; ksh
737 ;;;
738 ;;; Philippe Bondono <bondono@vnet.ibm.com>
739 (defvar fume-function-name-regexp-ksh
740 (concat
741 "\\(^\\s-*function\\s-+[A-Za-z_][A-Za-z_0-9]*\\)"
742 "\\|"
743 "\\(^\\s-*[A-Za-z_][A-Za-z_0-9]*\\s-*()\\)")
744 "Expression to get ksh function names")
745
746 ;;; Scheme
747 ;;;
748 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
749 (defvar fume-function-name-regexp-scheme
750 "^(define [ ]*"
751 "Expression to get Scheme function names")
752
753 ;;; BibTeX
754 ;;;
755 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
756 (defvar fume-function-name-regexp-bibtex
757 ;; "^@[A-Za-z]*[({]\\([A-Za-z0-9:;&-]*\\),"
758 ;; Christoph Wedler <wedler@fmi.uni-passau.de>
759 ;; According to the LaTeX Companion, this should be
760 "^@[A-Za-z]*[({]\\([A-Za-z][^ \t\n\"#%'()={}]*\\),"
761 "Expression to get bibtex citation headers.")
762
763 ;;; SGML
764 ;;;
765 ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
766 (defvar fume-function-name-regexp-sgml
767 "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\([A-Za-z][-A-Za-z.0-9]*\\)"
768 "Expression to find declaration of SGML element or entity")
769
770 ;;; Ada
771 ;;;
772 ;;; Michael Polo <mikep@polo.mn.org> <mikep@cfsmo.honeywell.com>
773 (defvar fume-function-name-regexp-ada
774 (cons "^[ \t]*\\(procedure\\|PROCEDURE\\|function\\|FUNCTION\\)[ \n\t]+\\([a-zA-Z0-9_]+\\|\"[^\"]\"\\)" 2)
775 "Expression to find declaration of Ada function")
776
777 ;;; ignore prototypes, 'renames', 'is new' to eliminate clutter
778 ;;;
779 ;;; Scott Evans <gse@ocsystems.com>
780 (defvar fume-function-name-regexp-ada-ignore
781 "[ \n\t]*\\(([^()]+)[ \n\t]*\\)?\\(return[ \t\n]+[^ \t\n;]+[ \n\t]*\\)?\\(;\\|is[ \n\t]+new[ \n\t]\\|renames\\)"
782 "ignore if ada function name matches this string")
783
784 ;;; Makefiles
785 ;;;
786 ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
787 (defvar fume-function-name-regexp-make
788 "^\\(\\(\\$\\s(\\)?\\(\\w\\|\\.\\)+\\(:sh\\)?\\(\\s)\\)?\\)\\s *\\(::?\\|\\+?=\\)"
789 "Expression to get makefile target names")
790
791 ;;; Directory Listings
792 ;;;
793 ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
794 ;;; regexp stolen from font-lock-mode
795 (defvar fume-function-name-regexp-dired
796 "^. +d.*\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\) +[0-9]+ +[0-9:]+ \\(.*\\)$"
797 "Expression to get directory names")
798
799 ;;; Pascal
800 ;;;
801 ;;; Espen Skoglund <espensk@stud.cs.uit.no>
802 (defvar fume-function-name-regexp-pascal
803 "^\\(function\\|procedure\\)[ \t]+\\([_a-zA-Z][_a-zA-Z0-9]*\\)"
804 "Expression to get function/procedure names in pascal.")
805
806
807 ;;; Fame
808 ;;;
809 ;;; Cooper Vertz <cooper@prod2.imsi.com>
810 (defvar fume-function-name-regexp-fame
811 "^\\(function\\|procedure\\)[ \t]+\\([#\\$%_a-zA-Z][#\\$%_a-zA-Z0-9]*\\)"
812 "Expression to get function/procedure names in fame.")
813
814
815 ;;; Verilog
816 ;;;
817 ;;; Matt Sale <mdsale@icdc.delcoelect.com>
818 (defvar fume-function-name-regexp-verilog
819 "^\\(task\\|function\\|module\\|primitive\\)[ \t]+\\([A-Za-z0-9_+-]*\\)[ \t]*(?"
820 "Expression to get verilog module names")
821
822
823 ;;; Assembly
824 (defvar fume-function-name-regexp-asm
825 "^\\([a-zA-Z_.$][a-zA-Z0-9_.$]*\\)[ \t]*:"
826 "Expression to get assembly label names")
827
828 ;;; This is where the mode specific regexp's are hooked in
829 ;;;
830 (defvar fume-function-name-regexp-alist
831 '(;; Lisp
832 (emacs-lisp-mode . fume-function-name-regexp-lisp)
833 (common-lisp-mode . fume-function-name-regexp-lisp)
834 (fi:common-lisp-mode . fume-function-name-regexp-lisp)
835 (fi:emacs-lisp-mode . fume-function-name-regexp-lisp)
836 (fi:franz-lisp-mode . fume-function-name-regexp-lisp)
837 (fi:inferior-common-lisp-mode . fume-function-name-regexp-lisp)
838 (fi:inferior-franz-lisp-mode . fume-function-name-regexp-lisp)
839 (fi:lisp-listener-mode . fume-function-name-regexp-lisp)
840 (lisp-mode . fume-function-name-regexp-lisp)
841 (lisp-interaction-mode . fume-function-name-regexp-lisp)
842
843 ;; C
844 (c-mode . fume-function-name-regexp-c)
845 (elec-c-mode . fume-function-name-regexp-c)
846 (c++-c-mode . fume-function-name-regexp-c)
847
848 ;; C++
849 (c++-mode . fume-function-name-regexp-c++)
850
851 ;; Fortran
852 (fortran-mode . fume-function-name-regexp-fortran)
853 (f90-mode . fume-function-name-regexp-fortran90)
854
855 ;; Modula
856 (modula-2-mode . fume-function-name-regexp-modula)
857 (modula-3-mode . fume-function-name-regexp-modula)
858
859 ;; Bacis2
860 (bacis-mode . fume-function-name-regexp-bacis)
861
862 ;; Maple
863 (maple-mode . fume-function-name-regexp-maple)
864
865 ;; Perl
866 (perl-mode . fume-function-name-regexp-perl)
867
868 ;; Java
869 (java-mode . fume-function-name-regexp-java)
870
871 ;; Python
872 (alice-mode . fume-function-name-regexp-python)
873 (python-mode . fume-function-name-regexp-python)
874
875 ;; Postscript
876 (postscript-mode . fume-function-name-regexp-postscript)
877
878 ;; Prolog
879 (prolog-mode . fume-function-name-regexp-prolog)
880
881 ;; Tcl
882 (tcl-mode . fume-function-name-regexp-tcl)
883
884 ;; ksh
885 (ksh-mode . fume-function-name-regexp-ksh)
886
887 ;; LaTeX
888 (latex-mode . fume-section-name-regexp-latex)
889 (LaTeX-mode . fume-section-name-regexp-latex)
890
891 ;; Scheme
892 (scheme-mode . fume-function-name-regexp-scheme)
893
894 ;; BibTeX
895 (bibtex-mode . fume-function-name-regexp-bibtex)
896
897 ;; Ehdm & PVS
898 (ehdm-mode . fume-function-name-regexp-ehdm)
899 (pvs-mode . fume-function-name-regexp-pvs)
900
901 ;; SGML
902 (sgml-mode . fume-function-name-regexp-sgml)
903
904 ;; Ada
905 (ada-mode . fume-function-name-regexp-ada)
906
907 ;; Makefiles
908 (makefile-mode . fume-function-name-regexp-make)
909
910 ;; Dired
911 (dired-mode . fume-function-name-regexp-dired)
912
913 ;; Pascal
914 (pascal-mode . fume-function-name-regexp-pascal)
915
916 ;; Fame
917 (fame-mode . fume-function-name-regexp-fame)
918
919 ;; Verilog
920 (verilog-mode . fume-function-name-regexp-verilog)
921
922 ;; Assembly
923 (asm-mode . fume-function-name-regexp-asm)
924 )
925
926 "The connection between a mode and the regexp that matches function names.")
927
928 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
929 ;;;;;;;;;;;;;;;;;;;;; Mode specific finding functions ;;;;;;;;;;;;;;;;;;;;
930 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
931
932 ;;; Default routine : Note, most modes will need a specialised routine
933 ;;;
934 (defun fume-find-next-function-name (buffer)
935 "Searches for the next function in BUFFER."
936 (set-buffer buffer)
937 ;; Search for the function
938 (if (re-search-forward fume-function-name-regexp nil t)
939 (let ((char (progn
940 (backward-up-list 1)
941 (save-excursion
942 (goto-char (scan-sexps (point) 1))
943 (skip-chars-forward "[ \t\n]")
944 (following-char)))))
945 ;; Skip this function name if it is a prototype declaration.
946 (if (and (eq char ?\;) (not (eq major-mode 'emacs-lisp-mode)))
947 (fume-find-next-function-name buffer)
948 ;; Get the function name and position
949 (let (beg)
950 (forward-sexp -1)
951 (setq beg (point))
952 (forward-sexp)
953 (cons (buffer-substring beg (point)) beg))))))
954
955 ;;; General purpose sexp find function
956 ;;;
957 (defun fume-find-next-sexp (buffer)
958 "Searches for the next sexp type function in BUFFER."
959 (set-buffer buffer)
960 (if (re-search-forward fume-function-name-regexp nil t)
961 (let ((beg (save-excursion (forward-sexp -1) (point))))
962 (cons (buffer-substring beg (point)) beg))))
963
964 ;;; Specialised routine to get the next ehdm entity in the buffer.
965 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
966 ;;;
967 (defun fume-find-next-ehdm-entity (buffer)
968 (set-buffer buffer)
969 (if (re-search-forward fume-function-name-regexp nil t)
970 (let ((beg (match-beginning 0))
971 (end (match-end 0)))
972 (cons (buffer-substring beg end) beg))))
973
974 ;;; Specialised routine to get the next PVS entity in the buffer.
975 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
976 ;;;
977 (defun fume-find-next-pvs-entity (buffer)
978 (set-buffer buffer)
979 (if (re-search-forward fume-function-name-regexp nil t)
980 (let ((beg (match-beginning 0))
981 (end (match-end 0)))
982 (goto-char (1- end))
983 (if (looking-at ":")
984 (setq end (1- end)))
985 (cons (buffer-substring beg end) beg))))
986
987 ;;; Specialised routine to get the next C function name in the buffer.
988 ;;;
989 (defun fume-find-next-c-function-name (buffer)
990 "Searches for the next C function in BUFFER."
991 (set-buffer buffer)
992 ;; Search for the function
993 (if (re-search-forward fume-function-name-regexp nil t)
994 (let ((char (progn
995 (backward-up-list 1)
996 (save-excursion
997 (goto-char (scan-sexps (point) 1))
998 (skip-chars-forward "[ \t\n]")
999 (following-char)))))
1000 ;; Skip this function name if it is a prototype declaration.
1001 (if (eq char ?\;)
1002 (fume-find-next-function-name buffer)
1003 (let (beg
1004 name)
1005 ;; Get the function name and position
1006 (forward-sexp -1)
1007 (setq beg (point))
1008 (forward-sexp)
1009 (setq name (buffer-substring beg (point)))
1010 ;; ghastly crock for DEFUN declarations
1011 (cond ((string-match "^DEFUN\\s-*" name)
1012 (forward-word 1)
1013 (forward-word -1)
1014 (setq beg (point))
1015 (cond ((re-search-forward "\"," nil t)
1016 (re-search-backward "\"," nil t)
1017 (setq name
1018 (format "%s %s"
1019 name
1020 (buffer-substring beg (point))))))))
1021 ;; kludge to avoid 'void' in menu
1022 (if (string-match "^void\\s-*" name)
1023 (fume-find-next-function-name buffer)
1024 (cons name beg)))))))
1025
1026 (defun fume-cc-inside-comment ()
1027 (let ((here (point))
1028 (bol-point (save-excursion (beginning-of-line) (point))))
1029 (or
1030 (save-excursion (and (re-search-backward "\/\/" bol-point t 1) t))
1031 (save-excursion
1032 (and
1033 (re-search-backward "\\(/[*]\\)\\|\\([*]/\\)" (point-min) t 1)
1034 (looking-at "/[*]")
1035 (goto-char here)
1036 (or (beginning-of-line 1) t)
1037 (re-search-forward "[ \t]*/?[*][ \t]*" here t 1)
1038 t)))))
1039
1040 ;;; <jrm@odi.com>
1041 ;;; <ajp@eng.cam.ac.uk>
1042 ;;; <schittko@fokus.gmd.de>
1043 ;;;
1044 (defun fume-match-find-next-function-name (buffer)
1045 "General next function name in BUFFER finder using match.
1046 The regexp is assumed to be a two item list the car of which is the regexp to
1047 use, and the cdr of which is the match position of the function name."
1048 (set-buffer buffer)
1049 (let ((result nil)
1050 (continue t)
1051 (regexp (car fume-function-name-regexp)))
1052 (while continue
1053 ;; Search for the function
1054 (if (re-search-forward regexp nil t)
1055 (if (fume-cc-inside-comment)
1056 () ; skip spurious finds in comments
1057 (let ((first-token (save-excursion
1058 (re-search-backward regexp nil t)
1059 (prog1 (fume-what-looking-at)
1060 (re-search-forward regexp nil t))))
1061 (last-char (progn
1062 (backward-up-list 1)
1063 (save-excursion
1064 (goto-char (scan-sexps (point) 1))
1065 (following-char)))))
1066 ;; Skip function name if it's a prototype or typedef declaration
1067 (if (or (eq last-char ?\;) (string= first-token "typedef"))
1068 nil
1069 (setq result
1070 ;; Get function name and position including scope
1071 (cons (buffer-substring
1072 (match-beginning (cdr fume-function-name-regexp))
1073 (point))
1074 (match-beginning (cdr fume-function-name-regexp)))
1075 continue nil))))
1076 (setq continue nil)))
1077 result))
1078
1079 ;;; Specialised routine to find the next Perl function
1080 ;;;
1081 (defun fume-find-next-perl-function-name (buffer)
1082 "Searches for the next Perl function in BUFFER."
1083 (fume-find-next-sexp buffer))
1084
1085 ;;; Specialised routine to find the next Java function
1086 ;;; Heddy Boubaker <boubaker@dgac.fr>
1087 ;;;
1088 (defun fume-find-next-java-function-name (buffer)
1089 "Searches for the next Java function in BUFFER."
1090 (set-buffer buffer)
1091 (if (re-search-forward fume-function-name-regexp nil t)
1092 (let ((beg (match-beginning 1))
1093 (end (match-end 1)))
1094 (goto-char (match-beginning 2))
1095 (forward-sexp)
1096 (if (and (looking-at "[^;(]*{")
1097 (not (fume-cc-inside-comment)))
1098 ;; This is a method definition and we're not
1099 ;; in a comment.
1100 (let ((str (buffer-substring beg end)))
1101 (or (string-match "if\\|switch\\|catch\\|for\\|while" str)
1102 ;; These constructs look like methods definitions
1103 ;; but are not.
1104 (cons str beg)))
1105 (fume-find-next-java-function-name buffer)))))
1106
1107 ;;; Specialised routine to find the next Python function
1108 ;;; Shuichi Koga <skoga@virginia.edu>
1109 ;;;
1110 (defun fume-find-next-python-function-name (buffer)
1111 "Searches for the next python function in BUFFER."
1112 (set-buffer buffer)
1113 (if (re-search-forward fume-function-name-regexp nil t)
1114 (save-excursion
1115 (let* ((retpnt (match-beginning 2))
1116 (retname (buffer-substring retpnt (match-end 2))))
1117 (goto-char (match-beginning 0))
1118 (cond ((looking-at "\\s-+def")
1119 (re-search-backward
1120 "^class\\s-*\\([A-Za-z0-9_]+\\)\\s-*[(:]" nil t)
1121 (setq retname
1122 (concat
1123 (buffer-substring (match-beginning 1) (match-end 1))
1124 "."
1125 retname))))
1126 (cons retname retpnt)))))
1127
1128 ;;; Specialised routine to find the next Modula function or subroutine.
1129 ;;;
1130 (defun fume-find-next-modula-function-name (buffer)
1131 "Searches for the next modula function in BUFFER."
1132 (fume-find-next-sexp buffer))
1133
1134 ;;; Specialised routine to find the next directory.
1135 ;;; Norbert Kiesel <norbert@i3.informatik.rwth-aachen.de>
1136 ;;;
1137 (defun fume-find-next-directory-name (buffer)
1138 "Searches for the next directory in dired BUFFER."
1139 (set-buffer buffer)
1140 ;; Search for the function
1141 (if (re-search-forward fume-function-name-regexp nil t)
1142 (let ((beg (match-beginning 2))
1143 (end (match-end 2)))
1144 (cons (buffer-substring beg end) beg))))
1145
1146 ;;; Specialised routine to find the next Fortran function or subroutine
1147 ;;;
1148 (defun fume-find-next-fortran-function-name (buffer)
1149 "Searches for the next Fortran function in BUFFER."
1150 (set-buffer buffer)
1151 (if (re-search-forward fume-function-name-regexp nil t)
1152 (let ((pos (point))
1153 ;; name may have "_" but must start with a letter
1154 (name-regexp "\\s-+[a-zA-Z]+[_a-zA-Z0-9*]*")
1155 (eol (save-excursion (end-of-line 1) (point))))
1156 (skip-chars-backward " \t")
1157 (if (re-search-forward name-regexp eol t)
1158 ;; name is ok; so return it
1159 (cons (buffer-substring pos (point)) pos)
1160 ;; rubbish found; skip to next function
1161 (fume-find-next-fortran-function-name buffer)))))
1162
1163 ;;; Specialised routine to get the next postscript function name in the buffer
1164 ;;; Leigh L. Klotz <klotz@adoc.xerox.com>
1165 ;;;
1166 (defun fume-find-next-postscript-function-name (buffer)
1167 "Searches for the next postscript function in BUFFER."
1168 (set-buffer buffer)
1169 (if (re-search-forward fume-function-name-regexp nil t)
1170 (let ((beg (progn (beginning-of-line 1) (point))))
1171 (forward-sexp)
1172 ;; keep including sexps as long as they
1173 ;; start with / or [.
1174 (if (looking-at "\\s-+\\(/\\|\\[\\)")
1175 (forward-sexp))
1176 (cons (buffer-substring beg (point)) beg))))
1177
1178 ;;; Specialised routine to get the next prolog fact/clause name in the buffer
1179 ;;; Laszlo Teleki <laszlo@ipb.uni-bonn.de>
1180 ;;;
1181 (defun fume-find-next-prolog-function-name (buffer)
1182 "Searches for the next prolog fact or clause in BUFFER."
1183 (set-buffer buffer)
1184 (if (re-search-forward fume-function-name-regexp nil t)
1185 (let ((beg (progn (beginning-of-line 1) (point))))
1186 (forward-sexp)
1187 (cons (buffer-substring beg (point)) beg))))
1188
1189 ;;; Specialised routine to get the next bacis2 procedure name in the buffer
1190 ;;;
1191 (defun fume-find-next-bacis-function-name (buffer)
1192 "Searches for the next Bacis2 function in BUFFER"
1193 (set-buffer buffer)
1194 (if (re-search-forward fume-function-name-regexp nil t)
1195 (let ((pos (point))
1196 (name (condition-case ()
1197 (funcall
1198 (symbol-function (intern "focus-get-function-name")))
1199 (error nil))))
1200 (if (null name)
1201 (fume-find-next-bacis-function-name buffer)
1202 ;; jump past possible function dbgid
1203 (re-search-forward
1204 (format "<<dbgid +\\s-*%s%s" name "\\s-*>>") nil t)
1205 (cons name pos)))))
1206
1207 ;;; Specialized routine to get the next Maple function name in the buffer
1208 ;;; Luc Tancredi <Luc.Tancredi@sophia.inria.fr>
1209 ;;;
1210 (defun fume-find-next-maple-function-name (buffer)
1211 "Searches for the next maple function in BUFFER"
1212 (set-buffer buffer)
1213 ;; Search for the function
1214 (if (re-search-forward fume-function-name-regexp nil t)
1215 (let ((beg (progn (backward-up-list 1) (forward-sexp -2) (point))))
1216 (forward-sexp)
1217 (cons (buffer-substring beg (point)) beg))))
1218
1219 ;;; Specialised routine to get the next latex section name in the buffer
1220 ;;; Philippe Queinnec <queinnec@cenatls.cena.dgac.fr>
1221 ;;; Paolo Frasconi <paolo@mcculloch.ing.unifi.it>
1222 ;;;
1223 (defun fume-find-next-latex-section-name (buffer)
1224 "Searches for the next latex section in BUFFER."
1225 (set-buffer buffer)
1226 (if (re-search-forward fume-function-name-regexp nil t)
1227 (let* ((secname (buffer-substring (match-beginning 1) (match-end 1)))
1228 (beg (match-beginning 4))
1229 (name (buffer-substring beg (match-end 4))))
1230 (cond ((string= secname "chapter")
1231 (setq fume-tex-chapter (1+ fume-tex-chapter)
1232 fume-tex-section 0
1233 fume-tex-subsection 0
1234 fume-tex-subsubsection 0
1235 name (concat fume-tex-chapter " " (upcase name))))
1236 ((string= secname "section")
1237 (setq fume-tex-section (1+ fume-tex-section)
1238 name (concat
1239 (if (> fume-tex-chapter 0)
1240 (concat fume-tex-chapter ".") "")
1241 fume-tex-section " " name)
1242 fume-tex-subsection 0
1243 fume-tex-subsubsection 0))
1244 ((string= secname "subsection")
1245 (setq fume-tex-subsection (1+ fume-tex-subsection)
1246 name (concat
1247 (if (> fume-tex-chapter 0)
1248 (concat fume-tex-chapter ".") "")
1249 fume-tex-section "."
1250 fume-tex-subsection " " name)
1251 fume-tex-subsubsection 0))
1252 ((string= secname "subsubsection")
1253 (setq fume-tex-subsubsection (1+ fume-tex-subsubsection)
1254 name (concat
1255 (if (> fume-tex-chapter 0)
1256 (concat fume-tex-chapter ".") "")
1257 fume-tex-section "."
1258 fume-tex-subsection "."
1259 fume-tex-subsubsection " " name)))
1260 ((string= secname "subsubsection")
1261 (setq name (concat " " name))))
1262 (cons name beg))))
1263
1264 ;;; Specialised routine to get the next ksh function in the buffer
1265 ;;; Philippe Bondono <bondono@vnet.ibm.com>
1266 ;;;
1267 (defun fume-find-next-ksh-function-name (buffer)
1268 "Searches for the ksh type function in BUFFER."
1269 (set-buffer buffer)
1270 ;; Search for the function
1271 (if (re-search-forward fume-function-name-regexp nil t)
1272 (let (name
1273 (beg (match-beginning 0)))
1274 (cond ((re-search-backward "\\(^\\|\\s-\\)function\\s-" beg t)
1275 (re-search-forward
1276 "\\(function\\s-+\\)\\([A-Za-z_][A-Za-z_0-9]*\\)" nil t)
1277 (setq beg (match-beginning 2)
1278 name (buffer-substring beg (match-end 2))))
1279 (t
1280 (re-search-backward
1281 "\\(^\\|\\s-\\)\\([A-Za-z_][A-Za-z_0-9]*\\)" beg t)
1282 (setq beg (match-beginning 2)
1283 name (buffer-substring beg (match-end 2)))))
1284 (if (null name)
1285 (fume-find-next-ksh-function-name buffer)
1286 (end-of-line)
1287 (cons name beg)))))
1288
1289 ;;; Specialised routine to get the next Scheme function in the buffer
1290 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
1291 ;;;
1292 (defun fume-find-next-scheme-function (buffer)
1293 "Searches for the next Scheme function in BUFFER."
1294 (set-buffer buffer)
1295 (if (re-search-forward fume-function-name-regexp nil t)
1296 (let ((beg (progn (if (looking-at "(") (forward-char 1)) (point)))
1297 (end (save-excursion (forward-sexp) (point))))
1298 (cons (buffer-substring beg end) beg))))
1299
1300 ;;; Specialised routine to get the next BibTeX citation in the buffer
1301 ;;; C. Michael Holloway <c.m.holloway@larc.nasa.gov>
1302 ;;;
1303 (defun fume-find-next-bibtex-citation (buffer)
1304 "Searches for the next BibTeX citation in BUFFER."
1305 (set-buffer buffer)
1306 (if (re-search-forward fume-function-name-regexp nil t)
1307 (let ((beg (match-beginning 1))
1308 (end (match-end 1)))
1309 (cons (buffer-substring beg end) beg))))
1310
1311 ;;; Specialised routine to get the next SGML declaration in the buffer
1312 ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
1313 ;;;
1314 (defun fume-find-next-sgml-element-name (buffer)
1315 "Searches for the next SGML declaration in BUFFER."
1316 (set-buffer buffer)
1317 (if (re-search-forward fume-function-name-regexp nil t)
1318 (let ((type (buffer-substring (match-beginning 1) (match-end 1)))
1319 (beg (match-beginning 2))
1320 (name (buffer-substring (match-beginning 2) (match-end 2))))
1321 (if (string= (downcase type) "element")
1322 (setq name (format "%-17s%3s" name "EL"))
1323 (setq name (format "%-17s%3s" name "ENT")))
1324 (cons name beg))))
1325
1326 ;;; Specialised routine to get the next ada function in the buffer
1327 ;;; Michael Polo <mikep@polo.mn.org> <mikep@cfsmo.honeywell.com>
1328 ;;;
1329 (defun fume-find-next-ada-function-name (buffer)
1330 "Searches for the next ada function in BUFFER."
1331 (set-buffer buffer)
1332 (if (re-search-forward (car fume-function-name-regexp-ada) nil t)
1333 (let ((beg (match-beginning (cdr fume-function-name-regexp-ada)))
1334 (end (match-end (cdr fume-function-name-regexp-ada))))
1335
1336 (if (looking-at fume-function-name-regexp-ada-ignore)
1337 (fume-find-next-ada-function-name buffer)
1338 (cons (buffer-substring beg end) beg)))))
1339
1340 ;;; Makefiles
1341 ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
1342 ;;;
1343 (defun fume-find-next-function-name-make (buffer)
1344 "Searches for the next make item in BUFFER."
1345 (set-buffer buffer)
1346 (if (re-search-forward fume-function-name-regexp nil t)
1347 (let ((beg (match-beginning 1))
1348 (end (match-end 1)))
1349 (cons (buffer-substring beg end) beg))))
1350
1351 ;;; Find next pascal function in the buffer
1352 ;;; Espen Skoglund <espensk@stud.cs.uit.no>
1353 ;;;
1354 (defun fume-find-next-pascal-function-name (buffer)
1355 "Searches for the next pascal procedure in BUFFER."
1356 (set-buffer buffer)
1357 (if (re-search-forward fume-function-name-regexp nil t)
1358 (let ((beg (match-beginning 2))
1359 (end (match-end 2)))
1360 (cons (buffer-substring beg end) beg))))
1361
1362 ;;; Verilog support
1363 ;;; Matt Sale <mdsale@icdc.delcoelect.com>
1364 ;;;
1365 (defun fume-find-next-verilog-function-name (buffer)
1366 "Searches for the next verilog module in BUFFER."
1367 (set-buffer buffer)
1368 (if (re-search-forward fume-function-name-regexp nil t)
1369 (let ((beg (match-beginning 2))
1370 (end (match-end 2)))
1371 (cons (buffer-substring beg end) beg))))
1372
1373 ;;; Assembly
1374 ;;; Bob Weiner <weiner@mot.com>
1375 ;;;
1376 (defun fume-find-next-asm-function-name (buffer)
1377 "Searches for the next assembler function in BUFFER."
1378 (set-buffer buffer)
1379 ;; Search for the function
1380 (if (re-search-forward fume-function-name-regexp nil t)
1381 (cons (buffer-substring (match-beginning 1) (match-end 1))
1382 (match-beginning 1))))
1383
1384 ;;; This is where you can hook in other languages which may need a different
1385 ;;; method to scan for function names. Otherwise, the default defun used is
1386 ;;; fume-find-next-function-name which is suitable for sexp-based languages
1387 ;;; such as C, C++ and elisp.
1388 ;;;
1389 (defconst fume-find-function-name-method-alist
1390 '((ada-mode . fume-find-next-ada-function-name)
1391 (alice-mode . fume-find-next-python-function-name)
1392 (asm-mode . fume-find-next-asm-function-name)
1393 (bacis-mode . fume-find-next-bacis-function-name)
1394 (bibtex-mode . fume-find-next-bibtex-citation)
1395 (c++-mode . fume-match-find-next-function-name)
1396 (c-mode . fume-find-next-c-function-name)
1397 (dired-mode . fume-find-next-directory-name)
1398 (ehdm-mode . fume-find-next-ehdm-entity)
1399 (fame-mode . fume-find-next-pascal-function-name)
1400 (fortran-mode . fume-find-next-fortran-function-name)
1401 (f90-mode . fume-find-next-fortran-function-name)
1402 (ksh-mode . fume-find-next-ksh-function-name)
1403 (latex-mode . fume-find-next-latex-section-name)
1404 (LaTeX-mode . fume-find-next-latex-section-name)
1405 (makefile-mode . fume-find-next-function-name-make)
1406 (maple-mode . fume-find-next-maple-function-name)
1407 (modula-2-mode . fume-find-next-modula-function-name)
1408 (modula-3-mode . fume-find-next-modula-function-name)
1409 (pascal-mode . fume-find-next-pascal-function-name)
1410 (perl-mode . fume-find-next-perl-function-name)
1411 (java-mode . fume-find-next-java-function-name)
1412 (postscript-mode . fume-find-next-postscript-function-name)
1413 (prolog-mode . fume-find-next-prolog-function-name)
1414 (pvs-mode . fume-find-next-pvs-entity)
1415 (python-mode . fume-find-next-python-function-name)
1416 (scheme-mode . fume-find-next-scheme-function)
1417 (sgml-mode . fume-find-next-sgml-element-name)
1418 (tcl-mode . fume-match-find-next-function-name)
1419 (verilog-mode . fume-find-next-verilog-function-name)
1420 )
1421
1422 "The connection between a mode and the defun that finds function names.
1423 If no connection is in this alist for a given mode, a default method is used")
1424
1425 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1426 ;;;;;;;;;;;;;;;;;;;;;;;; General utility functions ;;;;;;;;;;;;;;;;;;;;;;;
1427 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1428
1429 ;;; Routine to refresh the modeline
1430 ;;;
1431 (if (fboundp 'redraw-modeline) ; faster built-in method
1432 (defalias 'fume-refresh-modeline 'redraw-modeline)
1433 (defun fume-refresh-modeline () ; use old kludge method
1434 (set-buffer-modified-p (buffer-modified-p))))
1435
1436 ;;; Smart mouse positioning
1437 ;;;
1438 (if (fboundp 'window-edges) ; old method
1439 (defun fume-set-mouse-position ()
1440 (set-mouse-position
1441 (selected-frame)
1442 (nth 0 (window-edges)) (nth 1 (window-edges))))
1443 (defun fume-set-mouse-position () ; new method
1444 (set-mouse-position
1445 (selected-window)
1446 (nth 0 (window-pixel-edges))
1447 (nth 1 (window-pixel-edges)))))
1448
1449 ;;; Sets 'fume-function-name-regexp' to something appropriate for the current
1450 ;;; mode for this buffer.
1451 ;;;
1452 (defun fume-set-defaults ()
1453 "Returns nil if unsuccessful in setting up buffer-local defaults.
1454 Otherwise returns fume-function-name-regexp"
1455 (setq fume-function-name-regexp
1456 (symbol-value
1457 (cdr-safe (assoc major-mode fume-function-name-regexp-alist))))
1458 (if fume-function-name-regexp
1459 (setq fume-find-next-function-name-method
1460 (or (cdr-safe (assoc major-mode
1461 fume-find-function-name-method-alist))
1462 'fume-find-next-function-name)))
1463 fume-function-name-regexp)
1464
1465 ;;; Routines to add/remove/update function menu from menubar
1466 ;;;
1467 (defsubst fume-add-menubar-entry ()
1468 (interactive)
1469 (save-window-excursion (function-menu t)))
1470
1471 (defsubst fume-remove-menubar-entry ()
1472 (interactive)
1473 (cond ((and fume-running-xemacs current-menubar)
1474 (delete-menu-item (list fume-menubar-menu-name))
1475 ;; force update of the menubar
1476 (fume-refresh-modeline))))
1477
1478 (defsubst fume-update-menubar-entry ()
1479 "Returns t if menubar was updated. Nil otherwise"
1480 (and fume-running-xemacs
1481 fume-not-tty
1482 (assoc fume-menubar-menu-name current-menubar)
1483 (fume-add-menubar-entry)
1484 t))
1485
1486 (defsubst fume-trim-string (string)
1487 "Returns STRING with leading and trailing whitespace removed."
1488 (if (string-match "^[ \t]*" (setq string (format "%s" string)))
1489 (setq string (substring string (match-end 0))))
1490 (if (string-match "[ \t]*$" string)
1491 (setq string (substring string 0 (match-beginning 0))))
1492 string)
1493
1494 (defvar fume-syntax-table nil)
1495
1496 (defsubst fume-what-looking-at ()
1497 (let (name
1498 (orig-syntax-table (copy-syntax-table (syntax-table))))
1499 (if fume-syntax-table
1500 ()
1501 (setq fume-syntax-table (copy-syntax-table))
1502 (modify-syntax-entry ?: "w" fume-syntax-table))
1503 (unwind-protect
1504 (progn
1505 (set-syntax-table fume-syntax-table)
1506 (save-excursion
1507 (while (looking-at "\\sw\\|\\s_") (forward-char 1))
1508 (if (re-search-backward "\\sw\\|\\s_" nil t)
1509 (let ((beg (progn (forward-char 1) (point))))
1510 (forward-sexp -1)
1511 (while (looking-at "\\s'") (forward-char 1))
1512 (setq name (buffer-substring beg (point)))))))
1513 (set-syntax-table orig-syntax-table)
1514 name)))
1515
1516 ;;; Find function name that point is in.
1517 ;;; The trick is to start from the end...
1518 ;;;
1519 (defsubst fume-function-before-point ()
1520 (if (or fume-modeline-funclist (fume-rescan-buffer) fume-modeline-funclist)
1521 (let (result
1522 (pt (point)))
1523 (save-excursion
1524 (catch 'found
1525 (mapcar (function
1526 (lambda (p)
1527 (goto-char (cdr p))
1528 (beginning-of-line 1)
1529 (if (>= pt (point))
1530 (throw 'found (setq result (car p))))))
1531 fume-modeline-funclist))
1532 result))))
1533
1534 ;;; Routines to add a buffer local post command hook
1535 ;;;
1536 (defsubst fume-post-command-hook-p (hook)
1537 (memq hook (if fume-use-local-post-command-hook
1538 local-post-command-hook
1539 post-command-hook)))
1540
1541 (defsubst fume-add-post-command-hook (hook &optional append)
1542 (or (fume-post-command-hook-p hook)
1543 (cond (fume-use-local-post-command-hook
1544 (add-hook 'local-post-command-hook hook append))
1545 ((fboundp 'make-local-hook)
1546 (make-local-hook 'post-command-hook)
1547 (add-hook 'post-command-hook hook append t))
1548 (t
1549 ;; NOT make-variable-buffer-local
1550 (make-local-variable 'post-command-hook)
1551 (add-hook 'post-command-hook hook append)))))
1552
1553 (defsubst fume-remove-post-command-hook (hook)
1554 (and (fume-post-command-hook-p hook)
1555 (cond (fume-use-local-post-command-hook
1556 (remove-hook 'local-post-command-hook hook))
1557 ((fboundp 'make-local-hook)
1558 (remove-hook 'post-command-hook hook t))
1559 (t
1560 (remove-hook 'post-command-hook hook)))))
1561
1562 ;;; Routine to install the modeline feature
1563 ;;;
1564 (defsubst fume-maybe-install-modeline-feature ()
1565 (cond ((and fume-display-in-modeline-p (fume-set-defaults))
1566 (or fume-modeline-funclist
1567 (fume-post-command-hook-p 'fume-tickle-modeline)
1568 (fume-rescan-buffer))
1569 (fume-add-post-command-hook 'fume-tickle-modeline)
1570 (fume-remove-post-command-hook 'fume-maybe-install-modeline-feature)
1571 (fume-tickle-modeline-1)
1572 (fume-tickle-modeline)
1573 t ; return success flag
1574 )))
1575
1576 (defun fume-toggle-modeline-display ()
1577 "Toggles whether func-menu displays function names in the modeline"
1578 (interactive)
1579 (setq fume-display-in-modeline-p (not fume-display-in-modeline-p))
1580 (if (interactive-p) (fume-tickle-modeline)))
1581
1582 ;;; Routine to display function before point in the modeline
1583 ;;;
1584 (defun fume-tickle-modeline ()
1585 (let ((fname (and fume-display-in-modeline-p (fume-function-before-point))))
1586 (set fume-modeline-buffer-identification
1587 (cond ((and fume-display-in-modeline-p (not (null fname)))
1588 (setq fname (format "`%s'" (fume-trim-string fname)))
1589 (if (eq fume-display-in-modeline-p t)
1590 (list fume-modeline-buffer-identification-1 " " fname)
1591 fname))
1592 (t
1593 fume-modeline-buffer-identification-0))))
1594 (cond ((not fume-display-in-modeline-p)
1595 (fume-remove-post-command-hook 'fume-tickle-modeline)
1596 (fume-add-post-command-hook 'fume-maybe-install-modeline-feature)))
1597 ;; force an update of the mode line
1598 (fume-refresh-modeline))
1599
1600 (fume-defvar-local fume-modeline-buffer-identification-0 nil
1601 "Storage for original modeline-buffer-identification")
1602
1603 (fume-defvar-local fume-modeline-buffer-identification-1 nil
1604 "Storage for munged modeline-buffer-identification")
1605
1606 (defun fume-tickle-f-to-b (str)
1607 ;; Change modeline format of "XEmacs: %f" to "XEmacs: %b" in order to make
1608 ;; extra room for the function name which is going to be appended to the
1609 ;; modeline-buffer-identification component of the modeline-format.
1610 (cond ((consp str)
1611 (if (extentp (car str))
1612 (cons (car str)
1613 (fume-tickle-f-to-b (cdr str)))
1614 (mapcar (function fume-tickle-f-to-b) str)))
1615 ((not (stringp str))
1616 str)
1617 ((string-match "%[0-9]*f" str)
1618 (let ((newstr (copy-sequence str)))
1619 (aset newstr (1- (match-end 0)) (string-to-char "b"))
1620 newstr))
1621 (t str)))
1622
1623 (defun fume-tickle-modeline-1 ()
1624 (or fume-modeline-buffer-identification-0
1625 (setq fume-modeline-buffer-identification-0
1626 (symbol-value fume-modeline-buffer-identification)))
1627 (setq fume-modeline-buffer-identification-1
1628 (fume-tickle-f-to-b fume-modeline-buffer-identification-0)))
1629
1630 ;;; Routine to toggle auto recanning of the buffer
1631 (defun fume-toggle-auto-rescanning ()
1632 (interactive)
1633 (message "Func-Menu buffer auto-rescanning turned %s"
1634 (if (setq fume-auto-rescan-buffer-p (not fume-auto-rescan-buffer-p))
1635 "ON" "OFF"))
1636 (sit-for 0))
1637
1638 ;;; Routine to create a shallow separate copy of a list
1639 ;;;
1640 (if (fboundp 'copy-tree) ; not built-in in all emacsen
1641 (defalias 'fume-shallow-copy-list 'copy-tree)
1642 (defun fume-shallow-copy-list (list)
1643 (mapcar (function (lambda (i) (cons (car i) (cdr i)))) list)))
1644
1645 ;;; Sort function to sort items depending on their function-name
1646 ;;; An item looks like (NAME . POSITION).
1647 ;;;
1648 (defsubst fume-sort-by-name (item1 item2)
1649 (or (string-lessp (car item1) (car item2))
1650 (string-equal (car item1) (car item2))))
1651
1652 ;;; Sort function to sort items depending on their position
1653 ;;;
1654 (defsubst fume-sort-by-position (item1 item2)
1655 (<= (cdr item1) (cdr item2)))
1656
1657 ;;; Support function to calculate relative position in buffer
1658 ;;;
1659 (defsubst fume-relative-position ()
1660 (let ((pos (point))
1661 (total (buffer-size)))
1662 (if (> total 50000)
1663 ;; Avoid overflow from multiplying by 100!
1664 (/ (1- pos) (max (/ total 100) 1))
1665 (/ (* 100 (1- pos))
1666 (max total 1)))))
1667
1668 ;;; Split LIST into sublists of max length N
1669 ;;; Example (fume-split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
1670 ;;;
1671 (defsubst fume-split (list n)
1672 (let ((i 0)
1673 result
1674 sublist
1675 (remain list))
1676 (while remain
1677 (if (= n (setq sublist (cons (car remain) sublist)
1678 remain (cdr remain)
1679 i (1+ i)))
1680 ;; We have finished a sublist
1681 (setq result (cons (nreverse sublist) result)
1682 sublist nil
1683 i 0)))
1684 ;; There might be a sublist (if the length of LIST mod n is != 0)
1685 ;; that has to be added to the result list.
1686 (if sublist
1687 (setq result (cons (nreverse sublist) result)))
1688 (nreverse result)))
1689
1690 ;;; Routines to create indexes for submenus
1691 ;;;
1692
1693 ;;; Method 0
1694 ;;;
1695 (defun fume-index-sublist-method-0 (sublist count)
1696 (concat "Function sublist #" count))
1697
1698 ;;; Method 1
1699 ;;; Thomas Plass <thomas.plass@mid-heidelberg.de>
1700 ;;;
1701 (defun fume-index-sublist-method-1 (sublist &rest count)
1702 (interactive)
1703 (let ((s (substring (car (car sublist)) 0 1))
1704 (e (substring (car (nth (1- (length sublist)) sublist)) 0 1)))
1705 (format "Function sublist (%s%s)"
1706 s (if (string-equal s e) "<>" (format "<>-%s<>" e)))))
1707
1708 ;;; Method 2
1709 ;;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com>
1710 ;;;
1711 (defun fume-index-sublist-method-2 (sublist &rest count)
1712 (let ((s (substring (car (car sublist))
1713 0
1714 (min (length (car (car sublist))) 12)))
1715 (e (substring (car (nth (1- (length sublist)) sublist))
1716 0
1717 (min (length (car (nth (1- (length sublist)) sublist)))
1718 12))))
1719 (format "%s%s" s (if (string-equal s e) "<>" (format "<> ... %s<>" e)))))
1720
1721 ;;; Method 3
1722 ;;;
1723 (defun fume-index-sublist-method-3-1 (sublist ix limit)
1724 (let ((s1 (substring (car (car sublist)) 0 (min limit ix)))
1725 (s2 (substring
1726 (car (nth (1- (length sublist)) sublist))
1727 0 (min (length (car (nth (1- (length sublist)) sublist))) ix))))
1728 (cons s1 s2)))
1729
1730 (defun fume-index-sublist-method-3 (sublist &rest count)
1731 (let* ((cmplength 12)
1732 (limit (length (car (car sublist))))
1733 (result (fume-index-sublist-method-3-1 sublist cmplength limit))
1734 (str1 (car result))
1735 (str2 (cdr result)))
1736 (while (and (string-equal str1 str2) (< cmplength limit))
1737 (setq cmplength (1+ cmplength)
1738 result (fume-index-sublist-method-3-1 sublist cmplength limit)
1739 str1 (car result)
1740 str2 (cdr result)))
1741 (cond ((not (string-equal str1 str2))
1742 (format "%s<> ... %s<>" str1 str2))
1743 ((< cmplength limit)
1744 (format "%s<>" str1))
1745 (t
1746 (format "%s ..." str1)))))
1747
1748 ;;; Buffer rescanning
1749 ;;;
1750 (defun fume-rescan-buffer-trigger ()
1751 "Automatically spots when a buffer rescan becomes necessary"
1752 (if fume-auto-rescan-buffer-p
1753 (if (> fume-rescan-trigger-counter 0)
1754 (setq fume-rescan-trigger-counter (1- fume-rescan-trigger-counter))
1755 (setq fume-rescan-trigger-counter
1756 (/ (buffer-size) fume-rescan-trigger-counter-buffer-size))
1757 (if (or fume-funclist-dirty-p
1758 (save-excursion
1759 (let (find fnam)
1760 (condition-case ()
1761 (and fume-function-name-regexp
1762 (setq fnam (fume-function-before-point))
1763 (setq find (symbol-value
1764 'fume-find-next-function-name-method))
1765 (progn (end-of-line 1)
1766 (re-search-backward
1767 fume-function-name-regexp nil t))
1768 (if (eq find 'fume-find-next-latex-section-name)
1769 (let ((lnam
1770 (car (fume-find-next-latex-section-name
1771 (current-buffer)))))
1772 (fume-tex-rescan-buffer-hook)
1773 (not (string-equal
1774 (substring fnam
1775 (string-match " " fnam))
1776 (substring lnam
1777 (string-match " " lnam)))))
1778 (not (string-equal
1779 fnam
1780 (car (funcall find (current-buffer)))))))
1781 (error nil)))))
1782 (let ((fume-scanning-message nil))
1783 (fume-rescan-buffer))))))
1784
1785 (defsubst fume-install-rescan-buffer-trigger ()
1786 (cond ((not (fume-post-command-hook-p 'fume-rescan-buffer-trigger))
1787 (fume-add-post-command-hook 'fume-rescan-buffer-trigger 'append)
1788 ;; Make narrow-to-region tickle func-menu
1789 (or (fboundp 'fume-narrow-to-region)
1790 (fset 'fume-narrow-to-region
1791 (symbol-function 'narrow-to-region)))
1792 (defun narrow-to-region (b e)
1793 "Restrict editing in this buffer to the current region.
1794 The rest of the text becomes temporarily invisible and untouchable
1795 but is not deleted; if you save the buffer in a file, the invisible
1796 text is included in the file. C-x n w makes all visible again.
1797 See also `save-restriction'.
1798
1799 When calling from a program, pass two arguments; positions (integers
1800 or markers) bounding the text that should remain visible"
1801 (interactive "r")
1802 (fume-narrow-to-region b e)
1803 (if fume-funclist (setq fume-funclist-dirty-p t)))
1804 ;; Make widen tickle func-menu
1805 (or (fboundp 'fume-widen)
1806 (fset 'fume-widen (symbol-function 'widen)))
1807 (defun widen ()
1808 "Remove restrictions (narrowing) from current buffer.
1809 This allows the buffer's full text to be seen and edited."
1810 (interactive)
1811 (fume-widen)
1812 (if fume-funclist (setq fume-funclist-dirty-p t))))))
1813
1814 (defun fume-rescan-buffer (&optional popmenu)
1815 "Rescans the buffer for function names.
1816 If optional arg POPMENU is non-nil, brings up the function-menu."
1817 (interactive)
1818 (let ((find (symbol-value 'fume-find-next-function-name-method))
1819 (fnam)
1820 (flst '())
1821 (buffer-to-scan (current-buffer)))
1822 (save-excursion
1823 (goto-char (point-min))
1824 (cond (fume-scanning-message
1825 (message fume-scanning-message 0))
1826 (fume-rescanning-message
1827 (message fume-rescanning-message)))
1828 (while (setq fnam
1829 (condition-case ()
1830 (funcall find buffer-to-scan)
1831 (error
1832 ;; test for more possible fns after this error trap
1833 (if (consp fume-function-name-regexp)
1834 (save-excursion
1835 (re-search-forward
1836 (car fume-function-name-regexp) nil t))
1837 (and fume-function-name-regexp
1838 (save-excursion
1839 (re-search-forward
1840 fume-function-name-regexp nil t)))))))
1841 (cond ((listp fnam)
1842 (setq flst (cons fnam flst))
1843 (if fume-found-function-hook
1844 (save-excursion (run-hooks 'fume-found-function-hook)))))
1845 (if fume-scanning-message
1846 (message fume-scanning-message (fume-relative-position))))
1847 (cond (fume-scanning-message
1848 (message "%s done" (format fume-scanning-message 100)))
1849 (fume-rescanning-message
1850 (message "%s done" fume-rescanning-message)))
1851 ;; make a copy of flst sorted by position in buffer
1852 (setq fume-modeline-funclist
1853 (nreverse
1854 (sort (fume-shallow-copy-list flst) 'fume-sort-by-position)))
1855 (if fume-sort-function
1856 (setq fume-funclist (sort flst fume-sort-function))
1857 (setq fume-funclist (nreverse flst)))
1858 (if fume-rescan-buffer-hook
1859 (run-hooks 'fume-rescan-buffer-hook))))
1860 (if popmenu
1861 (function-menu)
1862 (let ((fume-rescan-inhibit-p t))
1863 (fume-update-menubar-entry)))
1864 ;; Reset dirty flag
1865 (setq fume-funclist-dirty-p nil))
1866
1867 ;;; Routine to position cursor
1868 ;;;
1869 (defun fume-goto-function (fn pos)
1870 "Position cursor at function FN at location POS"
1871 (let ((orig-pos (point))
1872 (case-fold-search nil)
1873 (match-fn (cond ((string-match "DEFUN " fn) ; Emacs DEFUN declaration
1874 (substring fn (match-end 0)))
1875 ((string-match "^[ \t]*" fn) ; strip leading spaces
1876 (substring fn (match-end 0)))
1877 (t
1878 fn))))
1879
1880 (save-excursion
1881 (goto-char pos)
1882 (or (looking-at match-fn)
1883 (let ((fume-scanning-message nil))
1884 (fume-rescan-buffer)
1885 (setq pos (cdr-safe (assoc fn fume-funclist))))))
1886
1887 (if pos
1888 (progn
1889 (goto-char pos)
1890 ;; possibly set mark
1891 (or (= orig-pos (point))
1892 (push-mark orig-pos (null fume-scanning-message)))
1893 (if (numberp fume-fn-window-position)
1894 (set-window-start
1895 (selected-window)
1896 (save-excursion
1897 (beginning-of-line
1898 (- 1 (min (- (window-height) 2) fume-fn-window-position)))
1899 (point)))
1900 (recenter)))
1901 (ding)
1902 (message "%s not found" fn)
1903 (function-menu))))
1904
1905 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1906 ;;;;;;;;;;;;;;;;;; The main entry points for this package ;;;;;;;;;;;;;;;;
1907 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1908
1909 ;;; Interface to function-menu for mouse bindings only
1910 ;;;
1911 (defun mouse-function-menu (event)
1912 "Wrapper for mouse button bindings for function-menu"
1913 (interactive "e")
1914 (let ((currwin (selected-window)))
1915 (condition-case ()
1916 (progn
1917 (select-window (fume-event-window event))
1918 (let ((fume-auto-position-popup nil))
1919 (call-interactively 'function-menu)))
1920 (error (select-window currwin)))))
1921
1922 ;;; Interface for Key bindings
1923 ;;;
1924 (defun function-menu (&optional use-menubar)
1925 "Pop up a menu of functions for selection with the mouse.
1926
1927 With a prefix arg adds the menu to the current menubar.
1928 Jumps to the selected function. A mark is set at the old position,
1929 so you can easily go back with C-u \\[set-mark-command]."
1930 (interactive "P")
1931
1932 (setq use-menubar
1933 (and use-menubar fume-running-xemacs fume-not-tty current-menubar))
1934
1935 (catch 'no-functions
1936 (or (fume-set-defaults)
1937 (if (not (interactive-p))
1938 (throw 'no-functions t)
1939 (error "func-menu does not support the mode \"%s\"" mode-name)))
1940
1941 ;; Create a list for this buffer only if there isn't any.
1942 (or fume-funclist
1943 (if fume-rescan-inhibit-p
1944 (fume-remove-menubar-entry)
1945 (fume-rescan-buffer)))
1946 (or fume-funclist
1947 (if (not (interactive-p))
1948 (throw 'no-functions t)
1949 (error "No functions found in this buffer.")))
1950
1951 ;; Rescan buffer trigger
1952 (fume-install-rescan-buffer-trigger)
1953
1954 ;; Function name in modeline
1955 (fume-maybe-install-modeline-feature)
1956
1957 ;; The rest of this routine works only for (Lucid) XEmacs
1958 (cond (fume-running-xemacs
1959 ;; Create the menu
1960 (let* ((count 0)
1961 (index-method
1962 (intern (format "fume-index-sublist-method-%d"
1963 fume-index-method)))
1964 function-menu
1965 (function-menu-items
1966 (mapcar
1967 (function
1968 (lambda (sublist)
1969 (setq count (1+ count))
1970 (cons (format "%s"
1971 (funcall index-method sublist count))
1972 (mapcar
1973 (function
1974 (lambda (menu)
1975 (vector (format "%s" (car menu))
1976 (list 'fume-goto-function
1977 (car menu) (cdr menu))
1978 t)))
1979 sublist))))
1980 (fume-split fume-funclist fume-max-items))))
1981
1982 (or (> count 1)
1983 (setq function-menu-items (cdr (car function-menu-items))))
1984
1985 (setq function-menu
1986 (` ((,@ function-menu-items)
1987 "----"
1988 ["Display full list of functions"
1989 fume-list-functions t]
1990 [(, (concat "Rescan buffer : " (buffer-name)))
1991 (fume-rescan-buffer (, (null use-menubar))) t]
1992 "----"
1993 ["Toggle modeline display"
1994 fume-toggle-modeline-display t]
1995 ["Toggle buffer auto rescanning"
1996 fume-toggle-auto-rescanning t]
1997 ["About Func-Menu" fume-about t])))
1998
1999 (cond (use-menubar
2000 (fume-remove-menubar-entry)
2001 (set-buffer-menubar (copy-sequence current-menubar))
2002 (fume-add-submenu
2003 fume-menubar-menu-name
2004 (` ((,@ function-menu)
2005 "----"
2006 ["Remove Function Menu from menubar"
2007 fume-remove-menubar-entry t]))
2008 fume-menubar-menu-location))
2009
2010 ((and fume-not-tty ; trap tty segmentation faults...
2011 (not (popup-menu-up-p)))
2012 (or (fume-update-menubar-entry)
2013 (setq function-menu
2014 (cons
2015 ["Put Function Menu into menubar"
2016 (function-menu t) t]
2017 (cons "----" function-menu))))
2018
2019 (if fume-auto-position-popup
2020 (fume-set-mouse-position))
2021
2022 (popup-menu (cons "Functions" function-menu)))))))))
2023
2024 (defun fume-mouse-function-goto (event)
2025 "Goto function clicked on or prompt in minibuffer (with completion)."
2026 (interactive "@e")
2027 (goto-char (event-point event))
2028 (let ((fume-no-prompt-on-valid-default t))
2029 (fume-prompt-function-goto)))
2030
2031 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2032 ;;;;;;;;;;;;;;;; Keyboard access to func-menu for tty users ;;;;;;;;;;;;;;
2033 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2034
2035 ;;; Internal variables only
2036 ;;;
2037 (defvar fume-list-srcbuffer nil)
2038 (defvar fume-list-reused-win-p nil)
2039 (defvar fume-list-trampled-buffer nil)
2040
2041 ;;; Espen Skoglund <espensk@stud.cs.uit.no>
2042 ;;; David Hughes <ukchugd@ukpmr.cs.philips.nl>
2043 ;;;
2044 (defun fume-prompt-function-goto (&optional other-window-p)
2045 "Goto function prompted for in minibuffer (with completion).
2046 With prefix arg, jumps to function in a different window."
2047 (interactive "P")
2048 (and (interactive-p) current-prefix-arg (setq other-window-p t))
2049 (let* ((default-name (fume-what-looking-at))
2050 (OrigBuffer (current-buffer))
2051 (TargetBuffer
2052 (if (eq major-mode 'fume-list-mode) fume-list-srcbuffer OrigBuffer))
2053 (fume-no-prompt-on-valid-default
2054 (or fume-no-prompt-on-valid-default
2055 (eq major-mode 'fume-list-mode))))
2056 (switch-to-buffer TargetBuffer)
2057 ;; Create funclist and set defaults
2058 (cond ((null fume-funclist)
2059 (fume-set-defaults)
2060 (fume-rescan-buffer)))
2061 (let* (;; verify default-name is a valid function name
2062 (default-exists-p (assoc default-name fume-funclist))
2063 ;; Prompt for function name in minibuffer, unless there is a valid
2064 ;; function name at point & fume-no-prompt-on-valid-default set to t
2065 (function-name
2066 (if (and default-exists-p
2067 fume-no-prompt-on-valid-default)
2068 ""
2069 (completing-read
2070 (format "Goto function%s%s: "
2071 (if other-window-p " other window" "")
2072 (if default-exists-p
2073 (concat " (" default-name ")")
2074 ""))
2075 fume-funclist nil t)))
2076 ;; Use default function name if just RET was pressed
2077 (function-name (if (and default-exists-p (string= "" function-name))
2078 default-name
2079 function-name)))
2080 (switch-to-buffer OrigBuffer)
2081 ;; Goto function or just return if function name is empty string
2082 (cond ((not (string= "" function-name))
2083 (if other-window-p
2084 (cond ((prog1 (one-window-p)
2085 (switch-to-buffer-other-window TargetBuffer))
2086 (other-window 1)
2087 (shrink-window-if-larger-than-buffer)
2088 (other-window 1)))
2089 (switch-to-buffer TargetBuffer))
2090 (fume-goto-function
2091 function-name (cdr (assoc function-name fume-funclist))))))))
2092
2093 (defun fume-prompt-function-goto-one-window ()
2094 (interactive)
2095 (delete-other-windows)
2096 (fume-prompt-function-goto))
2097
2098 (defun fume-prompt-function-goto-other-window ()
2099 (interactive)
2100 (let ((current-prefix-arg 1))
2101 (call-interactively 'fume-prompt-function-goto)))
2102
2103 (defun fume-list-functions-show-fn-other-window ()
2104 (interactive)
2105 (beginning-of-line)
2106 (select-window
2107 (prog1 (selected-window)
2108 (fume-prompt-function-goto-other-window))))
2109
2110 (defun fume-list-functions-show-prev-fn-other-window ()
2111 (interactive)
2112 (forward-line -1)
2113 (fume-list-functions-show-fn-other-window))
2114
2115 (defun fume-list-functions-show-next-fn-other-window ()
2116 (interactive)
2117 (forward-line 1)
2118 (beginning-of-line)
2119 (fume-list-functions-show-fn-other-window))
2120
2121 (defun fume-list-functions-help ()
2122 (interactive)
2123 (fume-about)
2124 (sit-for 1)
2125 (message "SPC=%s, p=%s, n=%s, o=%s, G=%s, RET=%s, q=%s"
2126 "this"
2127 "previous"
2128 "next"
2129 "other win"
2130 "one win"
2131 "this win"
2132 "quit"))
2133
2134 (defun fume-list-functions-quit ()
2135 (interactive)
2136 (if (eq major-mode 'fume-list-mode)
2137 (kill-buffer (current-buffer)))
2138 (if fume-list-reused-win-p
2139 (condition-case ()
2140 (switch-to-buffer fume-list-trampled-buffer)
2141 (error nil))
2142 (or (one-window-p)
2143 (delete-window (selected-window))))
2144 (if (not (eq (current-buffer) fume-list-srcbuffer))
2145 (condition-case ()
2146 (select-window (get-buffer-window fume-list-srcbuffer))
2147 (error
2148 (condition-case ()
2149 (switch-to-buffer fume-list-srcbuffer)
2150 (error nil))))))
2151
2152 (defun fume-list-mouse-select (event)
2153 (interactive "e")
2154 (let (ws cb cp (wc (current-window-configuration)))
2155 (mouse-set-point event)
2156 (fume-prompt-function-goto-other-window)
2157 (setq ws (save-excursion
2158 (beginning-of-line (- 1 fume-fn-window-position)) (point))
2159 cb (current-buffer)
2160 cp (point))
2161 (set-window-configuration wc)
2162 (switch-to-buffer cb)
2163 (set-window-start (selected-window) ws)
2164 (goto-char cp)))
2165
2166 (defvar fume-list-mode-map nil)
2167 (or fume-list-mode-map
2168 (let ((map (make-sparse-keymap)))
2169 (define-key map "q" 'fume-list-functions-quit)
2170 (define-key map "h" 'fume-list-functions-help)
2171 (define-key map "?" 'fume-list-functions-help)
2172 (define-key map "g" 'fume-prompt-function-goto)
2173 (define-key map "\C-m" 'fume-prompt-function-goto)
2174 (define-key map "G" 'fume-prompt-function-goto-one-window)
2175 (define-key map "o" 'fume-prompt-function-goto-other-window)
2176 (define-key map " " 'fume-list-functions-show-fn-other-window)
2177 (define-key map "p" 'fume-list-functions-show-prev-fn-other-window)
2178 (define-key map "n" 'fume-list-functions-show-next-fn-other-window)
2179 (if fume-not-tty
2180 (define-key map [(button2)] 'fume-list-mouse-select))
2181 (setq fume-list-mode-map map)))
2182
2183 (defvar fume-list-mode-hook nil "*Hook to run after fume-list-mode entered")
2184
2185 (defun fume-list-functions (&optional this-window)
2186 "Creates a temporary buffer listing functions found in the current buffer"
2187 (interactive "P")
2188 (let ((func-near-point (format "^%s$" (fume-function-before-point))))
2189 (cond ((or fume-function-name-regexp (fume-maybe-install-modeline-feature))
2190 (save-excursion
2191 (let ((srcbuffer (current-buffer)))
2192 (set-buffer (get-buffer-create fume-buffer-name))
2193 (let (buffer-read-only) (erase-buffer))
2194 (use-local-map fume-list-mode-map)
2195 (setq buffer-read-only t
2196 mode-name "Func-Menu"
2197 major-mode 'fume-list-mode
2198 fume-list-srcbuffer srcbuffer
2199 fume-list-reused-win-p (not (one-window-p)))
2200 (if fume-not-tty
2201 (setq mode-motion-hook 'mode-motion-highlight-symbol))
2202 (run-hooks 'fume-list-mode-hook)))
2203 (or fume-funclist (fume-rescan-buffer))
2204 (if fume-funclist
2205 (mapcar (function
2206 (lambda (p)
2207 (save-excursion
2208 (set-buffer fume-buffer-name)
2209 (let (buffer-read-only)
2210 (goto-char (point-max))
2211 (if (= (point-min) (point))
2212 (insert (car p))
2213 (insert (concat "\n" (car p))))
2214 (set-buffer-modified-p nil)
2215 (goto-char (point-min))))))
2216 fume-funclist))
2217 (cond ((interactive-p)
2218 (if current-prefix-arg
2219 (switch-to-buffer fume-buffer-name)
2220 (switch-to-buffer-other-window fume-buffer-name)
2221 (setq fume-list-trampled-buffer (other-buffer))
2222 (or fume-list-reused-win-p
2223 (shrink-window-if-larger-than-buffer)))
2224 (cond (func-near-point
2225 (re-search-forward func-near-point nil t)
2226 (beginning-of-line)))
2227 (fume-list-functions-help))))
2228 (t
2229 (error "Func-Menu is not operative in this buffer")))))
2230
2231 (provide 'func-menu)