Source

ilisp / ilisp-src.el

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
;;; -*- Mode: Emacs-Lisp -*-

;;; ilisp-src.el --
;;;
;;; This file is part of ILISP.
;;; Please refer to the file COPYING for copyrights and licensing
;;; information.
;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
;;; of present and past contributors.
;;;
;;; $Id$

(require 'cl)

;;; See ilisp.el for more information.

;;;%Source file operations
(unless (boundp 'tags-file-name)
  (defvar tags-file-name nil))

(defvar lisp-last-definition nil "Last definition (name type) looked for.")

(defvar lisp-last-file nil "Last used source file.")

(defvar lisp-first-point nil "First point found in last source file.")

(defvar lisp-last-point nil "Last point in last source file.")

(defvar lisp-last-locator nil "Last source locator used.")

(defvar lisp-search nil "Set to T when searching for definitions.")

(defvar lisp-using-tags nil "Set to T when using tags.")

;;;%%lisp-directory
(defvar lisp-edit-files t
  "Controls editing of of source files through Emacs' buffers.
If T, then buffers in one of 'lisp-source-modes' will be searched by
'edit-definitions-lisp' if the source cannot be found through the
inferior LISP.  It can also be a list of files to edit definitions
from set up by \(\\[lisp-directory]).  If it is set to nil, then no
additional files will be searched.")

;;;
(defun lisp-extensions ()
  "Return a regexp for matching file extensions.
The extensions are those of files that enter one of
'lisp-source-modes' according to 'auto-mode-alist'."
  (let ((entries auto-mode-alist)
	(extensions nil))
    (dolist (entry entries)
      (when (memq (cdr entry) lisp-source-modes)
	(setq extensions 
	      (concat "\\|" (car entry) extensions))))
    (substring extensions 2)))

;;;
(defun lisp-directory (directory add)
  "Edit the files in DIRECTORY.
The files must have an 'auto-mode' alist entry in 'lisp-source-modes'.
With a positive prefix, add the files on to the already existing
files.  With a negative prefix, clear the list.  In either case set
tags-file-name to nil so that tags are not used."
  (interactive 
   (list (if (not (eq current-prefix-arg '-))
	     (read-file-name "Lisp Directory: "
			     nil
			     default-directory
			     nil))
	     current-prefix-arg))
  (setq tags-file-name nil)
  (if (eq add '-)
      (progn (setq lisp-edit-files t)
	     (message "No current lisp directory"))
      (if add
	  (message "Added %s as a lisp directory" directory)
	  (message "%s is the lisp directory" directory))
      (setq directory (expand-file-name directory))
      (if (file-directory-p directory)
	  (setq lisp-edit-files
		(append
		 (directory-files directory t (lisp-extensions))
		 (if add (if (eq lisp-edit-files t) nil lisp-edit-files))))
	  (error "%s is not a directory" directory))))

;;;%%Utilities

(defun fix-source-filenames ()
  "Apply the 'ilisp-source-directory-fixup-alist' to the current buffer.
(The buffer should be *Edit-Definitions*) The aim is to change any
pre-compiledsource-file locations to point to local source file
locations.

See 'ilisp-source-directory-fixup-alist'."
  (let ((alist (ilisp-value 'ilisp-source-directory-fixup-alist t))
	cons)
    (if alist
	(save-excursion
	  (while alist
	    (setq cons (car alist))
	    (goto-char (point-min))
	    (if (re-search-forward (car cons) (point-max) t)
		(replace-match (cdr cons)))
	    (setq alist (cdr alist)))))))

(defun lisp-setup-edit-definitions (message edit-files)
  "Set up *Edit-Definitions* with MESSAGE.
If EDIT-FILES is T, insert all buffer filenames that are in one of
lisp-source-modes into the current buffer.  If it is a list of files
set up by lisp-directory, insert those in the buffer.  If it is a
string put that in the buffer."

  ;; Note
  ;; 19990804 Marco Antoniotti
  ;; Are we sure we want to set 'lisp-using-tags' to nil?
  (setq lisp-using-tags nil
	lisp-search (not (stringp edit-files)))
  (set-buffer (get-buffer-create "*Edit-Definitions*"))
  (erase-buffer)
  (insert message)
  (insert "\n\n")
  (if edit-files
      (progn
	(if (eq edit-files t)
	    (let ((buffers (buffer-list)))
	      (while buffers
		(let ((buffer (car buffers)))
		  (if (save-excursion 
			(set-buffer buffer) 
			(and (memq major-mode lisp-source-modes)
			     (buffer-file-name buffer)))
		      (progn (insert ?\") (insert (buffer-file-name buffer))
			     (insert "\"\n"))))
		(setq buffers (cdr buffers))))
	    (if (stringp edit-files)
		(progn (insert edit-files)
		       	;; Remove garbage collection messages
		       (replace-regexp "^;[^\n]*\n" "")
		       (fix-source-filenames))
		(let ((files edit-files))
		  (while files
		    (insert ?\")
		    (insert (car files))
		    (insert "\"\n")
		    (setq files (cdr files))))))
	(goto-char (point-min))
	(forward-line 2)
	(set-buffer-modified-p nil))
      (error 
       (substitute-command-keys
	"Use \\[lisp-directory] to define source files."))))
	  
;;;
(defun lisp-locate-definition (locator definition file point 
				       &optional
				       back pop)
  "Use LOCATOR to find the next DEFINITION (symbol . type) in FILE.
Search starts at POINT, optionally BACKWARDS and POP to buffer.  Return T
if successful."
  (if file 
      (if (not (file-exists-p file))
	  (progn
	    (message "File %s doesn't exist!" file)
	    (sit-for 1)
	    nil)
	  (let* ((symbol (car definition))
		 (type (cdr definition))
		 (first (not (eq lisp-last-file file)))
		 (buffer (current-buffer))
		 name)
	    (lisp-find-file file pop)
	    (if first (setq lisp-first-point (point)))
	    (if back
		(if first
		    (goto-char (point-max))
		    (goto-char point)
		    (forward-line -1) 
		    (end-of-line))
		(goto-char point)
		(if (not first) 
		    (progn (forward-line 1) (beginning-of-line))))
	    (if (eq type 't)
		(message "Search %s for %s" file symbol)
		(message "Searching %s for %s %s" file type
			 (setq name (lisp-buffer-symbol symbol))))
	    (if (funcall locator symbol type first back)
		(progn
		  (setq lisp-last-file file
			lisp-last-point (point))
		  (if (bolp)
		      (forward-line -1)
		      (beginning-of-line))
		  (recenter 0)
		  (if name 
		      (message "Found %s %s definition" type name)
		      (message "Found %s"))
		  t)
		(if first 
		    (goto-char lisp-first-point)
		    (set-buffer buffer)
		    (goto-char point))
		nil)))))

;;;
(defun lisp-next-file (back)
  "Return the next filename in *Edit-Definitions*, or nil if none."
  (let ((file t) 
	result)
    (set-buffer (get-buffer-create "*Edit-Definitions*"))
    (if back 
	(progn (forward-line -1)
	       (if (looking-at "\n")
		   (progn 
		     (forward-line 1)
		     (end-of-line)
		     (setq file nil)))))
  (if file
      (progn
	(skip-chars-forward "^\"")
	(if (eobp)
	    (progn (bury-buffer (current-buffer))
		   (setq result nil))
	    (let* ((start (progn (forward-char 1) (point))))
	      (skip-chars-forward "^\"") 
	      (setq file
		    (prog1 (buffer-substring start (point))
		      (end-of-line)))
	      (bury-buffer (current-buffer))))))
  (if (not (eq file 't)) file)))

;;;
(defun lisp-next-definition (back pop)
  "Go to the next definition from *Edit-Definitions*.
Movement is BACK with prefix and POPping.  Return 'first if found
first time, 'none if no definition ever, T if another definition is
found, and nil if no more definitions are found."

  (let ((done nil)
	(result nil))
    (while
	(not
	 (or
	  (setq result
		(lisp-locate-definition	;Same file
		 lisp-last-locator
		 lisp-last-definition lisp-last-file lisp-last-point back))
	  (let ((file (lisp-next-file back)))
	    (if file
		(if (lisp-locate-definition 
		     lisp-last-locator lisp-last-definition 
		     file 1 back 
		     (prog1 pop (setq pop nil)))
		    (setq result 'first)
		    (setq result (if (not lisp-search) 'none)))
		t)))))
    (set-buffer (window-buffer (selected-window)))
    result))

;;;%%Next-definition
(defun next-definition-lisp (back &optional pop)
  "Edit the next definition from *Edit-Definitions*.
Movement is BACK with prefix and optionally POPping or call
'tags-loop-continue' if using tags."
  (interactive "P")
  (if lisp-using-tags
      (tags-loop-continue)
      (let* ((result (lisp-next-definition back pop))
	     (symbol (car lisp-last-definition))
	     (type (cdr lisp-last-definition))
	     (name (if (not (eq type 't)) (lisp-buffer-symbol symbol))))
	(cond ((or (eq result 'first) (eq result 't))
	       (if name
		   (message "Found %s %s definition" type name)
		   (message "Found %s" symbol)))
	      ((eq result 'none)
	       (error "Can't find %s %s definition" type name))
	      (t 
	       (if name 
		   (error "No more %s %s definitions" type name)
		   (message "Done")))))))


;;;%%Edit-definitions
(defun edit-definitions-lisp (symbol type &optional stay search locator)
  "Find the source files for the TYPE definitions of SYMBOL.
If STAY, use the same window.  If SEARCH, do not look for symbol in
inferior LISP.  The definition will be searched for through the
inferior LISP and if not found it will be searched for in the current
tags file and if not found in the files in lisp-edit-files set up by
\(\\[lisp-directory]) or the buffers in one of lisp-source-modes if
lisp-edit-files is T.  If lisp-edit-files is nil, no search will be
done if not found through the inferior LISP.  TYPES are from
ilisp-source-types which is an alist of symbol strings or list
strings.  With a negative prefix, look for the current symbol as the
first type in ilisp-source-types."
  (interactive 
   (let* ((types (ilisp-value 'ilisp-source-types t))
	  (default (if types (car (car types))))
	  (function (lisp-function-name))
	  (symbol (lisp-buffer-symbol function)))
     (if (lisp-minus-prefix)
	 (list function default)
	 (list (ilisp-read-symbol 
		(format "Edit Definition [%s]: " symbol)
		function
		nil
		t)
	       (if types 
		   (ilisp-completing-read
		    (format "Type [%s]: " default)
		    types default))))))
  (let* ((name (lisp-buffer-symbol symbol))
	 (symbol-name (lisp-symbol-name symbol))
	 (command (ilisp-value 'ilisp-find-source-command t))
	 (source
	  (if (and command (not search) (comint-check-proc ilisp-buffer))
	      (ilisp-send
	       (format command symbol-name
		       (lisp-symbol-package symbol)
		       type)
	       (concat "Finding " type " " name " definitions")
	       'source )
	      "nil"))
	 (result (and source (lisp-last-line source)))
	 (source-ok (not (or (ilisp-value 'comint-errorp t)
			     (null result)
			     (string-match "nil" (car result)))))
	 (case-fold-search t)
	 (tagged nil))
    (unwind-protect
       (if (and tags-file-name (not source-ok))
	   (progn (setq lisp-using-tags t)
		  (cond 
		   (search
		    ;; Search through all files listed in tags table
		    (setq tags-loop-scan (list locator
					       (list 'quote symbol) 
					       type t nil)
			  tags-loop-operate nil)
		    (tags-loop-continue t))
		   (t
		    ;; Use tags
		    (if (string-match "Lucid" emacs-version)
			(find-tag symbol-name stay)
		      (find-tag symbol-name nil stay))))
		  (setq tagged t)))
       (if (not tagged)
	   (progn
	     (setq lisp-last-definition (cons symbol type)
		   lisp-last-file nil
		   lisp-last-locator (or locator (ilisp-value 'ilisp-locator)))
	     (lisp-setup-edit-definitions
	      (format "%s %s definitions:" type name)
	      (if source-ok (cdr result) lisp-edit-files))
	     (next-definition-lisp nil t))))))

;;;%%Searching
(defun lisp-locate-search (pattern type first back)
  "Find PATTERN in the current buffer."
  (if back
      (search-backward pattern nil t)
      (search-forward pattern nil t)))

;;;
(defun lisp-locate-regexp (regexp type first back)
  "Find REGEXP in the current buffer."
  (if back
      (re-search-backward regexp nil t)
      (re-search-forward regexp nil t)))

;;;

(defvar lisp-last-pattern nil "Last search regexp.")

(defun search-lisp (pattern regexp)
  "Search for PATTERN through the files or buffers.
Search for file in 'lisp-edit-files' if it is a list or the
current buffers in one of 'lisp-source-modes' otherwise.  If
lisp-edit-files is nil, no search will be done.  If called with a
prefix, search for regexp.  If there is a tags file, call 'tags-search'
instead."
  (interactive
   (list (read-string (if current-prefix-arg 
			  "Search for regexp: "
			  "Search for: ") lisp-last-pattern)
	 current-prefix-arg))
  (if tags-file-name
      (progn (setq lisp-using-tags t)
	     (tags-search (if regexp pattern (regexp-quote pattern))))
      (setq lisp-last-pattern pattern
	    lisp-last-definition (cons pattern t)
	    lisp-last-file nil
	    lisp-last-locator (if regexp
				  'lisp-locate-regexp
				  'lisp-locate-search))
      (lisp-setup-edit-definitions (format "Searching for %s:" pattern) 
				   lisp-edit-files)
      (next-definition-lisp nil nil)))

;;;%%Replacing
(defvar lisp-last-replace nil "Last replace regexp.")

(defun replace-lisp (old new regexp)
  "Query replace OLD by NEW through the files or the current buffers.
The query is done in 'lisp-edit-files' if it is a list and the current
buffers in one of 'lisp-source-modes' otherwise.  If 'lisp-edit-files'
is NIL, no search will be done.  If called with a prefix, replace
regexps.  If there is a tags file, then call tags-query-replace
instead."
  (interactive
   (let ((old (read-string (if current-prefix-arg
			       "Replace regexp: "
			       "Replace: ") lisp-last-pattern)))
     (list old
	   (read-string (if current-prefix-arg
			    (format "Replace regexp %s by: " old)
			    (format "Replace %s by: " old))
			lisp-last-replace)
	   current-prefix-arg)))
  (cond (tags-file-name
	 (setq lisp-using-tags t)
	 (tags-query-replace (if regexp old (regexp-quote old))
			     new))
	(t
	 (setq lisp-last-pattern old
	       lisp-last-replace new)
	 (lisp-setup-edit-definitions 
	  (format "Replacing %s by %s:\n\n" old new)
	  lisp-edit-files)
	 (let ((file nil))
	   (while (setq file (lisp-next-file nil))
	     (lisp-find-file file)
	     (let ((point (point)))
	       (goto-char (point-min))
	       (if (if regexp 
		       (re-search-forward old nil t)
		       (search-forward old nil t))
		   (progn (beginning-of-line)
			  (if regexp
			      (query-replace-regexp old new)
			      (query-replace old new)))
		   (goto-char point))))))))

;;;%%Edit-callers
(defvar lisp-callers nil 
  "T if we found callers through inferior LISP.")

;;;
(defun who-calls-lisp (function &optional no-show)
  "Put the functions that call FUNCTION into the buffer *All-Callers*.
Show the buffer *All-Callers* unless NO-SHOW is T.  Return T if successful."
  (interactive 
   (let* ((function (lisp-defun-name))
	  (symbol (lisp-buffer-symbol function)))
     (if (lisp-minus-prefix)
	 (list function)
	 (list (ilisp-read-symbol 
		(format "Who Calls [%s]: " symbol)
		function
		t t)))))
  (let* ((name (lisp-buffer-symbol function))
	 (command (ilisp-value 'ilisp-callers-command t))
	 (callers
	  (if command
	      (ilisp-send
	       (format command
		       (lisp-symbol-name function)
		       (lisp-symbol-package function))
	       (concat "Finding callers of " name)
	       'callers)))
	 (last-line (if callers (lisp-last-line callers)))
	 (case-fold-search t))
    (set-buffer (get-buffer-create "*All-Callers*"))
    (erase-buffer)
    (insert (format "All callers of function %s:\n\n" name))
    (if (and command (not (ilisp-value 'comint-errorp t)))
	(if (string-match "nil" (car last-line))
	    (error "%s has no callers" name)
	    (message "")
	    (insert (cdr last-line))
	    (goto-char (point-min))
	    ;; Remove garbage collection messages
	    (replace-regexp "^;[^\n]*\n" "")
	    (goto-char (point-min))
	    (forward-line 2)
	    (if (not no-show) 
		(if (ilisp-temp-buffer-show-function)
		    (funcall (ilisp-temp-buffer-show-function)
			     (get-buffer "*All-Callers*"))
		    (view-buffer "*All-Callers*")))
	    t)
	(insert "Using the current source files to find callers.")
	nil)))

;;;
(defun next-caller-lisp (back &optional pop)
  "Edit the next caller from *All-Callers*.
With prefix, edit the previous caller.  If it can't get caller
information from the inferior LISP, this will search using the current
source files.  See lisp-directory."

  (interactive "P")
  (if (not lisp-callers)
      (next-definition-lisp back pop)
      (set-buffer (get-buffer-create "*All-Callers*"))
      (if back (forward-line -1))
      (skip-chars-forward " \t\n")
      (if (eobp)
	  (progn
	    (bury-buffer (current-buffer))
	    (error "No more callers"))
	  (let* ((start (point))
		 (caller-function
		  (progn
		    (skip-chars-forward "^ \t\n")
		    (buffer-substring start (point)))))
	    (bury-buffer (current-buffer))
	    (edit-definitions-lisp (lisp-string-to-symbol caller-function) 
				  (car (car (ilisp-value 'ilisp-source-types)))
				  (not pop))))))

;;;
(defun edit-callers-lisp (function)
  "Edit the callers of FUNCTION.
With a minus prefix use the symbol at the start of the current defun."
  (interactive
   (let* ((function (lisp-defun-name)))
     (if (lisp-minus-prefix)
	 (list function)
	 (list (ilisp-read-symbol 
		(format "Edit callers of [%s]: "
			(lisp-buffer-symbol function))
		function
		t)))))
  (if (save-excursion (setq lisp-callers (who-calls-lisp function t)))
      (progn 
	(setq lisp-last-locator (ilisp-value 'ilisp-calls-locator))
	(next-caller-lisp nil t))
      (edit-definitions-lisp function "calls" nil t 
			    (ilisp-value 'ilisp-calls-locator))))

;;;%Locators
(defun lisp-re (back format &rest args)
  "Search BACK if T using FORMAT applied to ARGS."
  (let ((regexp (apply 'format format args)))
    (if back
	(re-search-backward regexp nil t)
	(re-search-forward regexp nil t))))

;;;
(defun lisp-locate-ilisp (symbol type first back)
  "Find SYMBOL's TYPE definition in the current file.
Return T if successful.  A definition is of the form
\(def<whitespace>(?name<whitespace>."
  (lisp-re back
	   "^[ \t\n]*(def[^ \t\n]*[ \t\n]+(?%s[ \t\n(]+" 
	   (regexp-quote (lisp-symbol-name symbol))))

;;;
(defun lisp-locate-calls (symbol type first back)
  "Locate calls to SYMBOL."
  (lisp-re back "\\(#'\\|(\\|'\\)%s\\([ \t\n]+\\|)\\)"
	   (regexp-quote (lisp-buffer-symbol symbol))))


;;;%%Common LISP

;;; ilisp-cl-source-locater-patterns --
;;;
;;; Note:
;;;
;;; 19990804 Marco Antoniotti
;;; The new ones (method and generic-fucntion) should be carefully checked.

(defvar ilisp-cl-source-locater-patterns
  '((setf
     "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(setf\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*)")

    (function
     "^\\(.\\)?[ \t\n]*(defun\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")

    (macro
     "^\\(.\\)?[ \t\n]*(defmacro\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")

    (variable
     "^\\(.\\)?[ \t\n]*(def\\(\\(var\\)\\|\\(parameter\\)\\|constant\\)\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")

    (structure
     "^\\(.\\)?[ \t\n]*(defstruct\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(?[ \t\n]*\\(.\\)?[ \t\n]*%s[ \t\n(]")

    (type
     "^\\(.\\)?[ \t\n]*(deftype\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")

    (class
     "^\\(.\\)?[ \t\n]*(defclass\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")

    (method
     "^\\(.\\)?[ \t\n]*(defmethod\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")

    (generic-function
     "^\\(.\\)?[ \t\n]*(defgeneric\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
    ))


(defun ilisp-locate-clisp-defn (name type back)
  (let ((pattern (car (cdr (assoc (intern type)
				  ilisp-cl-source-locater-patterns)))))
    (when pattern
      (lisp-re back pattern name))))



(defun ilisp-locate-clos-method (name type back)
  (if (string-match "(\\([^(]*\\)\\(([^)]*)\\)" type)
      (let* ((quals (substring type (match-beginning 1) (match-end 1)))
	     (class
	      (read (substring type (match-beginning 2) (match-end 2))))
	     (class-re nil)
	     (position 0))
	(while (setq position (string-match 
			       "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
			       quals position))
	  (setq quals
		(concat (substring quals 0 position)
			"\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
			(substring quals (match-end 0)))))
	(while class
	  (setq class-re 
		(concat 
		 class-re 
		 (format
		  "[ \t\n]*\\(.\\)?[ \t\n]*([ \t\n]*\\(.\\)?[ \t\n]*[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*"
		  (car class)))
		class (cdr class)))
	(lisp-re back 
		 "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[^ \t\n]*([^ \t\n]*%s"
		 name quals class-re))))




(defun lisp-locate-clisp (symbol type first back)
  "Try to find SYMBOL's TYPE definition in the current buffer.
Return T if sucessful.  FIRST is T if this is the first time in a
file.  BACK is T to go backwards."

  (let* ((name (regexp-quote (lisp-symbol-name symbol)))
	 (prefix 
	  ;; Automatically generated defstruct accessors
	  (if (string-match "-" name)
	      (let ((struct (substring name 0 (1- (match-end 0)))))
		(format 
		 "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?\\|\\|[ \t\n]*.[ \t\n]+\\)(?%s[ \t\n)]\\|:conc-name\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s-" 
		 struct struct))))
	 ;; Defclass accessors
	 (class
	  "\\(:accessor\\|:writer\\|:reader\\)\\([ \t\n]+\\(.\\)?+[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n)]"))
    (or
     (if (equal type "any")
	 (lisp-re 
	  back
	  (concat
	   "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)\\((setf\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)\\|(?[ \t\n]*\\(.\\)?[ \t\n]*\\)%s[ \t\n)]"
	   (if prefix (concat "\\|" prefix))
	   "\\|"
	   class)
	  name name))

     ;; (qualifiers* (type1 type2 ...))
     (ilisp-locate-clos-method name type back)

     (ilisp-locate-clisp-defn name type back)

     ;; Standard def form
     (when first (lisp-locate-ilisp symbol type first back))
     ;; Automatically generated defstruct accessors
     (when (and first prefix) (lisp-re back prefix))
     ;; Defclass accessors
     (lisp-re back class name)
     ;; Give up!
     )))

;;;%% Locators for Scheme

;;; Matthias Koeppe <mail.math.uni-magdeburg.de>
;;;
;;; The standard locators would fail on "(define (thunk) ....)"  and
;;; report "(define (procedure ...) ....)" as a call to procedure.

(defun ilisp-locate-scheme-definition (symbol type first back)
  "Find SYMBOL's TYPE definition in the current file. Return T if successful.
This is the Scheme counterpart of `lisp-locate-ilisp'."
  (lisp-re back
	   "[ \t\n]*(def[^ \t\n]*[ \t\n]+(*%s\[ \t\n()]" 
	   (regexp-quote (lisp-symbol-name symbol))))

(defun ilisp-locate-scheme-calls (symbol type first back)
  "Locate calls to SYMBOL.
This is the Scheme counterpart of `lisp-locate-calls'."
  (let ((call-regexp 
	 (format "[( \t\n]+%s[ \t\n()]+"
		 (regexp-quote 
		  ;; Scheme has no package prefixes, so we use
		  ;; lisp-symbol-name instead of lisp-buffer-symbol.
		  (lisp-symbol-name symbol))))
	(def-regexp "[ \t\n]*(def[^ \t\n]*[ \t\n]+(*")
	(result 'unknown))
    (while (eq result 'unknown)
      (cond 
       ((if back
	    (re-search-backward call-regexp nil t)
	  (re-search-forward call-regexp nil t))
	(if (not (save-excursion	; check whether definition
		   (goto-char (match-beginning 0))
		   (backward-sexp) (backward-char)
		   (looking-at def-regexp)))
	    (setq result t)))
       (t (setq result nil))))
    result))	    


;;; end of file -- ilisp-src.el --
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.