xemacs-beta: lisp/ilisp/ilisp-src.el comparison

comparison lisp/ilisp/ilisp-src.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	b82b59fe008d

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;; -*- Mode: Emacs-Lisp -*-
+;;; ilisp-src.el --
+;;; This file is part of ILISP.
+;;; Version: 5.7
+;;;
+;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
+;;;               1993, 1994 Ivan Vasquez
+;;;               1994, 1995 Marco Antoniotti and Rick Busdiecker
+;;;
+;;; Other authors' names for which this Copyright notice also holds
+;;; may appear later in this file.
+;;;
+;;; Send mail to 'ilisp-request@lehman.com' to be included in the
+;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
+;;; mailing list were bugs and improvements are discussed.
+;;;
+;;; ILISP is freely redistributable under the terms found in the file
+;;; COPYING.
+;;; See ilisp.el for more information.
+;;;%Source file operations
+(if (not (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
+"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 the extensions of files that enter one
+of lisp-source-modes according to auto-mode-alist."
+(let ((entries auto-mode-alist)
+	(extensions nil))
+(while entries
+(let ((entry (car entries)))
+	(if (memq (cdr entry) lisp-source-modes)
+	    (setq extensions
+		  (concat "\\|" (car entry) extensions))))
+(setq entries (cdr entries)))
+(substring extensions 2)))
+;;;
+(defun lisp-directory (directory add)
+"Edit the files in DIRECTORY that 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
+(which will be *Edit-Definitions*) to change any pre-compiled
+source-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."
+(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
+starting 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* going 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* going 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)
+		  (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 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, 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 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)))
+(if tags-file-name
+(progn (setq lisp-using-tags t)
+	     (tags-query-replace (if regexp old (regexp-quote old))
+				 new))
+(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)
+	(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*
+and show it 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 (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 and 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
+(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(]")
+))
+(defun ilisp-locate-clisp-defn (name type back)
+(let ((pattern (car (cdr (assoc (intern type) ilisp-cl-source-locater-patterns)))))
+(if 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 and 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
+(if first (lisp-locate-ilisp symbol type first back))
+;; Automatically generated defstruct accessors
+(if (and first prefix) (lisp-re back prefix))
+;; Defclass accessors
+(lisp-re back class name)
+;; Give up!
+)))

Mercurial > hg > xemacs-beta

comparison lisp/ilisp/ilisp-src.el @ 0:376386a54a3c r19-14