Mercurial > hg > xemacs-beta
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) |