home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / ilisp / ilisp-src.el < prev    next >
Encoding:
Text File  |  1995-01-26  |  21.2 KB  |  640 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-src.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.7
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995 Marco Antoniotti and Rick Busdiecker
  11. ;;;
  12. ;;; Other authors' names for which this Copyright notice also holds
  13. ;;; may appear later in this file.
  14. ;;;
  15. ;;; Send mail to 'ilisp-request@lehman.com' to be included in the
  16. ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
  17. ;;; mailing list were bugs and improvements are discussed.
  18. ;;;
  19. ;;; ILISP is freely redistributable under the terms found in the file
  20. ;;; COPYING.
  21.  
  22.  
  23.  
  24. ;;; See ilisp.el for more information.
  25.  
  26. ;;;%Source file operations
  27. (if (not (boundp 'tags-file-name)) (defvar tags-file-name nil))
  28. (defvar lisp-last-definition nil "Last definition (name type) looked for.")
  29. (defvar lisp-last-file nil "Last used source file.")
  30. (defvar lisp-first-point nil "First point found in last source file.")
  31. (defvar lisp-last-point nil "Last point in last source file.")
  32. (defvar lisp-last-locator nil "Last source locator used.")
  33. (defvar lisp-search nil "Set to T when searching for definitions.")
  34. (defvar lisp-using-tags nil "Set to T when using tags.")
  35.  
  36. ;;;%%lisp-directory
  37. (defvar lisp-edit-files t
  38.   "If T, then buffers in one of lisp-source-modes will be searched by
  39. edit-definitions-lisp if the source cannot be found through the
  40. inferior LISP.  It can also be a list of files to edit definitions
  41. from set up by \(\\[lisp-directory]).  If it is set to nil, then no
  42. additional files will be searched.")
  43.  
  44. ;;;
  45. (defun lisp-extensions ()
  46.   "Return a regexp for matching the extensions of files that enter one
  47. of lisp-source-modes according to auto-mode-alist."
  48.   (let ((entries auto-mode-alist)
  49.     (extensions nil))
  50.     (while entries
  51.       (let ((entry (car entries)))
  52.     (if (memq (cdr entry) lisp-source-modes)
  53.         (setq extensions 
  54.           (concat "\\|" (car entry) extensions))))
  55.       (setq entries (cdr entries)))
  56.   (substring extensions 2)))
  57.  
  58. ;;;
  59. (defun lisp-directory (directory add)
  60.   "Edit the files in DIRECTORY that have an auto-mode alist entry in
  61. lisp-source-modes.  With a positive prefix, add the files on to the
  62. already existing files.  With a negative prefix, clear the list.  In
  63. either case set tags-file-name to nil so that tags are not used."
  64.   (interactive 
  65.    (list (if (not (eq current-prefix-arg '-))
  66.          (read-file-name "Lisp Directory: "
  67.                  nil
  68.                  default-directory
  69.                  nil))
  70.          current-prefix-arg))
  71.   (setq tags-file-name nil)
  72.   (if (eq add '-)
  73.       (progn (setq lisp-edit-files t)
  74.          (message "No current lisp directory"))
  75.       (if add
  76.       (message "Added %s as a lisp directory" directory)
  77.       (message "%s is the lisp directory" directory))
  78.       (setq directory (expand-file-name directory))
  79.       (if (file-directory-p directory)
  80.       (setq lisp-edit-files
  81.         (append
  82.          (directory-files directory t (lisp-extensions))
  83.          (if add (if (eq lisp-edit-files t) nil lisp-edit-files))))
  84.       (error "%s is not a directory" directory))))
  85.  
  86. ;;;%%Utilities
  87.  
  88. (defun fix-source-filenames ()
  89.   "Apply the ilisp-source-directory-fixup-alist to the current buffer
  90.    (which will be *Edit-Definitions*) to change any pre-compiled
  91.    source-file locations to point to local source file locations.  
  92.    See ilisp-source-directory-fixup-alist."
  93.   (let ((alist (ilisp-value 'ilisp-source-directory-fixup-alist t))
  94.     cons)
  95.     (if alist
  96.     (save-excursion
  97.       (while alist
  98.         (setq cons (car alist))
  99.         (goto-char (point-min))
  100.         (if (re-search-forward (car cons) (point-max) t)
  101.         (replace-match (cdr cons)))
  102.         (setq alist (cdr alist)))))))
  103.  
  104. (defun lisp-setup-edit-definitions (message edit-files)
  105.   "Set up *Edit-Definitions* with MESSAGE. If EDIT-FILES is T, insert
  106. all buffer filenames that are in one of lisp-source-modes into the
  107. current buffer.  If it is a list of files set up by lisp-directory,
  108. insert those in the buffer.  If it is a string put that in the buffer."
  109.   (setq lisp-using-tags nil
  110.     lisp-search (not (stringp edit-files)))
  111.   (set-buffer (get-buffer-create "*Edit-Definitions*"))
  112.   (erase-buffer)
  113.   (insert message)
  114.   (insert "\n\n")
  115.   (if edit-files
  116.       (progn
  117.     (if (eq edit-files t)
  118.         (let ((buffers (buffer-list)))
  119.           (while buffers
  120.         (let ((buffer (car buffers)))
  121.           (if (save-excursion 
  122.             (set-buffer buffer) 
  123.             (and (memq major-mode lisp-source-modes)
  124.                  (buffer-file-name buffer)))
  125.               (progn (insert ?\") (insert (buffer-file-name buffer))
  126.                  (insert "\"\n"))))
  127.         (setq buffers (cdr buffers))))
  128.         (if (stringp edit-files)
  129.         (progn (insert edit-files)
  130.                    ;; Remove garbage collection messages
  131.                (replace-regexp "^;[^\n]*\n" "")
  132.                (fix-source-filenames))
  133.         (let ((files edit-files))
  134.           (while files
  135.             (insert ?\")
  136.             (insert (car files))
  137.             (insert "\"\n")
  138.             (setq files (cdr files))))))
  139.     (goto-char (point-min))
  140.     (forward-line 2)
  141.     (set-buffer-modified-p nil))
  142.       (error 
  143.        (substitute-command-keys
  144.     "Use \\[lisp-directory] to define source files."))))
  145.       
  146. ;;;
  147. (defun lisp-locate-definition (locator definition file point 
  148.                        &optional
  149.                        back pop)
  150.   "Use LOCATOR to find the next DEFINITION (symbol . type) in FILE
  151. starting at POINT, optionally BACKWARDS and POP to buffer.  Return T
  152. if successful."
  153.   (if file 
  154.       (if (not (file-exists-p file))
  155.       (progn
  156.         (message "File %s doesn't exist!" file)
  157.         (sit-for 1)
  158.         nil)
  159.       (let* ((symbol (car definition))
  160.          (type (cdr definition))
  161.          (first (not (eq lisp-last-file file)))
  162.          (buffer (current-buffer))
  163.          name)
  164.         (lisp-find-file file pop)
  165.         (if first (setq lisp-first-point (point)))
  166.         (if back
  167.         (if first
  168.             (goto-char (point-max))
  169.             (goto-char point)
  170.             (forward-line -1) 
  171.             (end-of-line))
  172.         (goto-char point)
  173.         (if (not first) 
  174.             (progn (forward-line 1) (beginning-of-line))))
  175.         (if (eq type 't)
  176.         (message "Search %s for %s" file symbol)
  177.         (message "Searching %s for %s %s" file type
  178.              (setq name (lisp-buffer-symbol symbol))))
  179.         (if (funcall locator symbol type first back)
  180.         (progn
  181.           (setq lisp-last-file file
  182.             lisp-last-point (point))
  183.           (if (bolp)
  184.               (forward-line -1)
  185.               (beginning-of-line))
  186.           (recenter 0)
  187.           (if name 
  188.               (message "Found %s %s definition" type name)
  189.               (message "Found %s"))
  190.           t)
  191.         (if first 
  192.             (goto-char lisp-first-point)
  193.             (set-buffer buffer)
  194.             (goto-char point))
  195.         nil)))))
  196.  
  197. ;;;
  198. (defun lisp-next-file (back)
  199.   "Return the next filename in *Edit-Definitions*, or nil if none."
  200.   (let ((file t) 
  201.     result)
  202.     (set-buffer (get-buffer-create "*Edit-Definitions*"))
  203.     (if back 
  204.     (progn (forward-line -1)
  205.            (if (looking-at "\n")
  206.            (progn 
  207.              (forward-line 1)
  208.              (end-of-line)
  209.              (setq file nil)))))
  210.   (if file
  211.       (progn
  212.     (skip-chars-forward "^\"")
  213.     (if (eobp)
  214.         (progn (bury-buffer (current-buffer))
  215.            (setq result nil))
  216.         (let* ((start (progn (forward-char 1) (point))))
  217.           (skip-chars-forward "^\"") 
  218.           (setq file
  219.             (prog1 (buffer-substring start (point))
  220.               (end-of-line)))
  221.           (bury-buffer (current-buffer))))))
  222.   (if (not (eq file 't)) file)))
  223.  
  224. ;;;
  225. (defun lisp-next-definition (back pop)
  226.   "Go to the next definition from *Edit-Definitions* going BACK with
  227. prefix and POPPING.  Return 'first if found first time, 'none if no
  228. definition ever, T if another definition is found, and nil if no more
  229. definitions are found."
  230.   (let ((done nil)
  231.     (result nil))
  232.     (while
  233.     (not
  234.      (or
  235.       (setq result
  236.         (lisp-locate-definition    ;Same file
  237.          lisp-last-locator
  238.          lisp-last-definition lisp-last-file lisp-last-point back))
  239.       (let ((file (lisp-next-file back)))
  240.         (if file
  241.         (if (lisp-locate-definition 
  242.              lisp-last-locator lisp-last-definition 
  243.              file 1 back 
  244.              (prog1 pop (setq pop nil)))
  245.             (setq result 'first)
  246.             (setq result (if (not lisp-search) 'none)))
  247.         t)))))
  248.     (set-buffer (window-buffer (selected-window)))
  249.     result))
  250.  
  251. ;;;%%Next-definition
  252. (defun next-definition-lisp (back &optional pop)
  253.   "Edit the next definition from *Edit-Definitions* going BACK with
  254. prefix and optionally POPPING or call tags-loop-continue if using tags."
  255.   (interactive "P")
  256.   (if lisp-using-tags
  257.       (tags-loop-continue)
  258.       (let* ((result (lisp-next-definition back pop))
  259.          (symbol (car lisp-last-definition))
  260.          (type (cdr lisp-last-definition))
  261.          (name (if (not (eq type 't)) (lisp-buffer-symbol symbol))))
  262.     (cond ((or (eq result 'first) (eq result 't))
  263.            (if name
  264.            (message "Found %s %s definition" type name)
  265.            (message "Found %s" symbol)))
  266.           ((eq result 'none)
  267.            (error "Can't find %s %s definition" type name))
  268.           (t 
  269.            (if name 
  270.            (error "No more %s %s definitions" type name)
  271.            (message "Done")))))))
  272.  
  273.  
  274. ;;;%%Edit-definitions
  275. (defun edit-definitions-lisp (symbol type &optional stay search locator)
  276.   "Find the source files for the TYPE definitions of SYMBOL.  If STAY,
  277. use the same window.  If SEARCH, do not look for symbol in inferior
  278. LISP.  The definition will be searched for through the inferior LISP
  279. and if not found it will be searched for in the current tags file and
  280. if not found in the files in lisp-edit-files set up by
  281. \(\\[lisp-directory]) or the buffers in one of lisp-source-modes if
  282. lisp-edit-files is T.  If lisp-edit-files is nil, no search will be
  283. done if not found through the inferior LISP.  TYPES are from
  284. ilisp-source-types which is an alist of symbol strings or list
  285. strings.  With a negative prefix, look for the current symbol as the
  286. first type in ilisp-source-types."
  287.   (interactive 
  288.    (let* ((types (ilisp-value 'ilisp-source-types t))
  289.       (default (if types (car (car types))))
  290.       (function (lisp-function-name))
  291.       (symbol (lisp-buffer-symbol function)))
  292.      (if (lisp-minus-prefix)
  293.      (list function default)
  294.      (list (ilisp-read-symbol 
  295.         (format "Edit Definition [%s]: " symbol)
  296.         function
  297.         nil
  298.         t)
  299.            (if types 
  300.            (ilisp-completing-read
  301.             (format "Type [%s]: " default)
  302.             types default))))))
  303.   (let* ((name (lisp-buffer-symbol symbol))
  304.      (symbol-name (lisp-symbol-name symbol))
  305.      (command (ilisp-value 'ilisp-find-source-command t))
  306.      (source
  307.       (if (and command (not search) (comint-check-proc ilisp-buffer))
  308.           (ilisp-send
  309.            (format command symbol-name
  310.                (lisp-symbol-package symbol)
  311.                type)
  312.            (concat "Finding " type " " name " definitions")
  313.            'source )
  314.           "nil"))
  315.      (result (and source (lisp-last-line source)))
  316.      (source-ok (not (or (ilisp-value 'comint-errorp t)
  317.                  (null result)
  318.                  (string-match "nil" (car result)))))
  319.      (case-fold-search t)
  320.      (tagged nil))
  321.     (unwind-protect
  322.        (if (and tags-file-name (not source-ok))
  323.        (progn (setq lisp-using-tags t)
  324.           (if (string-match "Lucid" emacs-version)
  325.               (find-tag symbol-name stay)
  326.               (find-tag symbol-name nil stay))
  327.           (setq tagged t)))
  328.        (if (not tagged)
  329.        (progn
  330.          (setq lisp-last-definition (cons symbol type)
  331.            lisp-last-file nil
  332.            lisp-last-locator (or locator (ilisp-value 'ilisp-locator)))
  333.          (lisp-setup-edit-definitions
  334.           (format "%s %s definitions:" type name)
  335.           (if source-ok (cdr result) lisp-edit-files))
  336.          (next-definition-lisp nil t))))))
  337.  
  338. ;;;%%Searching
  339. (defun lisp-locate-search (pattern type first back)
  340.   "Find PATTERN in the current buffer."
  341.   (if back
  342.       (search-backward pattern nil t)
  343.       (search-forward pattern nil t)))
  344.  
  345. ;;;
  346. (defun lisp-locate-regexp (regexp type first back)
  347.   "Find REGEXP in the current buffer."
  348.   (if back
  349.       (re-search-backward regexp nil t)
  350.       (re-search-forward regexp nil t)))
  351.  
  352. ;;;
  353. (defvar lisp-last-pattern nil "Last search regexp.")
  354. (defun search-lisp (pattern regexp)
  355.   "Search for PATTERN through the files in lisp-edit-files if it is a
  356. list and the current buffers in one of lisp-source-modes otherwise.
  357. If lisp-edit-files is nil, no search will be done.  If called with a
  358. prefix, search for regexp.  If there is a tags file, call tags-search instead."
  359.   (interactive
  360.    (list (read-string (if current-prefix-arg 
  361.               "Search for regexp: "
  362.               "Search for: ") lisp-last-pattern)
  363.      current-prefix-arg))
  364.   (if tags-file-name
  365.       (progn (setq lisp-using-tags t)
  366.          (tags-search (if regexp pattern (regexp-quote pattern))))
  367.       (setq lisp-last-pattern pattern
  368.         lisp-last-definition (cons pattern t)
  369.         lisp-last-file nil
  370.         lisp-last-locator (if regexp
  371.                   'lisp-locate-regexp
  372.                   'lisp-locate-search))
  373.       (lisp-setup-edit-definitions (format "Searching for %s:" pattern) 
  374.                    lisp-edit-files)
  375.       (next-definition-lisp nil nil)))
  376.  
  377. ;;;%%Replacing
  378. (defvar lisp-last-replace nil "Last replace regexp.")
  379. (defun replace-lisp (old new regexp)
  380.   "Query replace OLD by NEW through the files in lisp-edit-files if it
  381. is a list and the current buffers in one of lisp-source-modes
  382. otherwise.  If lisp-edit-files is nil, no search will be done.  If
  383. called with a prefix, replace regexps.  If there is a tags file, then
  384. call tags-query-replace instead."
  385.   (interactive
  386.    (let ((old (read-string (if current-prefix-arg
  387.                    "Replace regexp: "
  388.                    "Replace: ") lisp-last-pattern)))
  389.      (list old
  390.        (read-string (if current-prefix-arg
  391.                 (format "Replace regexp %s by: " old)
  392.                 (format "Replace %s by: " old))
  393.             lisp-last-replace)
  394.        current-prefix-arg)))
  395.   (if tags-file-name
  396.       (progn (setq lisp-using-tags t)
  397.          (tags-query-replace (if regexp old (regexp-quote old))
  398.                  new))
  399.       (setq lisp-last-pattern old
  400.         lisp-last-replace new)
  401.       (lisp-setup-edit-definitions 
  402.        (format "Replacing %s by %s:\n\n" old new)
  403.        lisp-edit-files)
  404.       (let (file)
  405.     (while (setq file (lisp-next-file nil))
  406.       (lisp-find-file file)
  407.       (let ((point (point)))
  408.         (goto-char (point-min))
  409.         (if (if regexp 
  410.             (re-search-forward old nil t)
  411.             (search-forward old nil t))
  412.         (progn (beginning-of-line)
  413.                (if regexp
  414.                (query-replace-regexp old new)
  415.                (query-replace old new)))
  416.         (goto-char point)))))))
  417.  
  418. ;;;%%Edit-callers
  419. (defvar lisp-callers nil 
  420.   "T if we found callers through inferior LISP.")
  421.  
  422. ;;;
  423. (defun who-calls-lisp (function &optional no-show)
  424.   "Put the functions that call FUNCTION into the buffer *All-Callers*
  425. and show it unless NO-SHOW is T.  Return T if successful."
  426.   (interactive 
  427.    (let* ((function (lisp-defun-name))
  428.       (symbol (lisp-buffer-symbol function)))
  429.      (if (lisp-minus-prefix)
  430.      (list function)
  431.      (list (ilisp-read-symbol 
  432.         (format "Who Calls [%s]: " symbol)
  433.         function
  434.         t t)))))
  435.   (let* ((name (lisp-buffer-symbol function))
  436.      (command (ilisp-value 'ilisp-callers-command t))
  437.      (callers
  438.       (if command
  439.           (ilisp-send
  440.            (format command
  441.                (lisp-symbol-name function)
  442.                (lisp-symbol-package function))
  443.            (concat "Finding callers of " name)
  444.            'callers)))
  445.      (last-line (lisp-last-line callers))
  446.      (case-fold-search t))
  447.     (set-buffer (get-buffer-create "*All-Callers*"))
  448.     (erase-buffer)
  449.     (insert (format "All callers of function %s:\n\n" name))
  450.     (if (and command (not (ilisp-value 'comint-errorp t)))
  451.     (if (string-match "nil" (car last-line))
  452.         (error "%s has no callers" name)
  453.         (message "")
  454.         (insert (cdr last-line))
  455.         (goto-char (point-min))
  456.         ;; Remove garbage collection messages
  457.         (replace-regexp "^;[^\n]*\n" "")
  458.         (goto-char (point-min))
  459.         (forward-line 2)
  460.         (if (not no-show) 
  461.         (if (ilisp-temp-buffer-show-function)
  462.             (funcall (ilisp-temp-buffer-show-function)
  463.                  (get-buffer "*All-Callers*"))
  464.             (view-buffer "*All-Callers*")))
  465.         t)
  466.     (insert "Using the current source files to find callers.")
  467.     nil)))
  468.  
  469. ;;;
  470. (defun next-caller-lisp (back &optional pop)
  471.   "Edit the next caller from *All-Callers*.  With prefix, edit
  472. the previous caller.  If it can't get caller information from the
  473. inferior LISP, this will search using the current source files.  See
  474. lisp-directory."
  475.   (interactive "P")
  476.   (if (not lisp-callers)
  477.       (next-definition-lisp back pop)
  478.       (set-buffer (get-buffer-create "*All-Callers*"))
  479.       (if back (forward-line -1))
  480.       (skip-chars-forward " \t\n")
  481.       (if (eobp)
  482.       (progn
  483.         (bury-buffer (current-buffer))
  484.         (error "No more callers"))
  485.       (let* ((start (point))
  486.          (caller-function
  487.           (progn
  488.             (skip-chars-forward "^ \t\n")
  489.             (buffer-substring start (point)))))
  490.         (bury-buffer (current-buffer))
  491.         (edit-definitions-lisp (lisp-string-to-symbol caller-function) 
  492.                   (car (car (ilisp-value 'ilisp-source-types)))
  493.                   (not pop))))))
  494.  
  495. ;;;
  496. (defun edit-callers-lisp (function)
  497.   "Edit the callers of FUNCTION.  With a minus prefix use the symbol
  498. at the start of the current defun."
  499.   (interactive
  500.    (let* ((function (lisp-defun-name)))
  501.      (if (lisp-minus-prefix)
  502.      (list function)
  503.      (list (ilisp-read-symbol 
  504.         (format "Edit callers of [%s]: "
  505.             (lisp-buffer-symbol function))
  506.         function
  507.         t)))))
  508.   (if (save-excursion (setq lisp-callers (who-calls-lisp function t)))
  509.       (progn 
  510.     (setq lisp-last-locator (ilisp-value 'ilisp-calls-locator))
  511.     (next-caller-lisp nil t))
  512.       (edit-definitions-lisp function "calls" nil t 
  513.                 (ilisp-value 'ilisp-calls-locator))))
  514.  
  515. ;;;%Locators
  516. (defun lisp-re (back format &rest args)
  517.   "Search BACK if T using FORMAT applied to ARGS."
  518.   (let ((regexp (apply 'format format args)))
  519.     (if back
  520.     (re-search-backward regexp nil t)
  521.     (re-search-forward regexp nil t))))
  522.  
  523. ;;;
  524. (defun lisp-locate-ilisp (symbol type first back)
  525.   "Find SYMBOL's TYPE definition in the current file and return T if
  526. successful.  A definition is of the form
  527. \(def<whitespace>(?name<whitespace>."
  528.   (lisp-re back
  529.        "^[ \t\n]*(def[^ \t\n]*[ \t\n]+(?%s[ \t\n(]+" 
  530.        (regexp-quote (lisp-symbol-name symbol))))
  531.  
  532. ;;;
  533. (defun lisp-locate-calls (symbol type first back)
  534.   "Locate calls to SYMBOL."
  535.   (lisp-re back "\\(#'\\|(\\|'\\)%s\\([ \t\n]+\\|)\\)"
  536.        (regexp-quote (lisp-buffer-symbol symbol))))
  537.  
  538.  
  539. ;;;%%Common LISP
  540.  
  541. (defvar ilisp-cl-source-locater-patterns
  542.   '((setf
  543.      "^\\(.\\)?[ \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]*)")
  544.  
  545.     (function
  546.      "^\\(.\\)?[ \t\n]*(defun\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  547.  
  548.     (macro
  549.      "^\\(.\\)?[ \t\n]*(defmacro\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  550.  
  551.     (variable
  552.      "^\\(.\\)?[ \t\n]*(def\\(\\(var\\)\\|\\(parameter\\)\\|constant\\)\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  553.  
  554.     (structure
  555.      "^\\(.\\)?[ \t\n]*(defstruct\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(?[ \t\n]*\\(.\\)?[ \t\n]*%s[ \t\n(]")
  556.  
  557.     (type
  558.      "^\\(.\\)?[ \t\n]*(deftype\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  559.  
  560.     (class
  561.      "^\\(.\\)?[ \t\n]*(defclass\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  562.     ))
  563.  
  564.  
  565. (defun ilisp-locate-clisp-defn (name type back)
  566.   (let ((pattern (car (cdr (assoc (intern type) ilisp-cl-source-locater-patterns)))))
  567.     (if pattern
  568.     (lisp-re back pattern name))))
  569.  
  570.  
  571.  
  572. (defun ilisp-locate-clos-method (name type back)
  573.   (if (string-match "(\\([^(]*\\)\\(([^)]*)\\)" type)
  574.       (let* ((quals (substring type (match-beginning 1) (match-end 1)))
  575.          (class
  576.           (read (substring type (match-beginning 2) (match-end 2))))
  577.          (class-re nil)
  578.          (position 0))
  579.     (while (setq position (string-match 
  580.                    "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
  581.                    quals position))
  582.       (setq quals
  583.         (concat (substring quals 0 position)
  584.             "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
  585.             (substring quals (match-end 0)))))
  586.     (while class
  587.       (setq class-re 
  588.         (concat 
  589.          class-re 
  590.          (format
  591.           "[ \t\n]*\\(.\\)?[ \t\n]*([ \t\n]*\\(.\\)?[ \t\n]*[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*"
  592.           (car class)))
  593.         class (cdr class)))
  594.     (lisp-re back 
  595.          "^\\(.\\)?[ \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"
  596.          name quals class-re))))
  597.  
  598.  
  599.  
  600.  
  601. (defun lisp-locate-clisp (symbol type first back)
  602.   "Try to find SYMBOL's TYPE definition in the current buffer and return
  603. T if sucessful.  FIRST is T if this is the first time in a file.  BACK
  604. is T to go backwards."
  605.   (let* ((name (regexp-quote (lisp-symbol-name symbol)))
  606.      (prefix 
  607.       ;; Automatically generated defstruct accessors
  608.       (if (string-match "-" name)
  609.           (let ((struct (substring name 0 (1- (match-end 0)))))
  610.         (format 
  611.          "^\\(.\\)?[ \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-" 
  612.          struct struct))))
  613.      ;; Defclass accessors
  614.      (class
  615.       "\\(:accessor\\|:writer\\|:reader\\)\\([ \t\n]+\\(.\\)?+[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n)]"))
  616.     (or
  617.      (if (equal type "any")
  618.      (lisp-re 
  619.       back
  620.       (concat
  621.        "^\\(.\\)?[ \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)]"
  622.        (if prefix (concat "\\|" prefix))
  623.        "\\|"
  624.        class)
  625.       name name))
  626.  
  627.      ;; (qualifiers* (type1 type2 ...))
  628.      (ilisp-locate-clos-method name type back)
  629.  
  630.      (ilisp-locate-clisp-defn name type back)
  631.  
  632.      ;; Standard def form
  633.      (if first (lisp-locate-ilisp symbol type first back))
  634.      ;; Automatically generated defstruct accessors
  635.      (if (and first prefix) (lisp-re back prefix))
  636.      ;; Defclass accessors
  637.      (lisp-re back class name)
  638.      ;; Give up!
  639.      )))
  640.