(defun find-sexp-match (pattern)
  ;; top loop: iterate over top level forms
  (setf pattern (sexp-match-flatten pattern))
  (setf $ nil)
  (setf $$ nil)
  (catch 'done
    (goto-char 0)
    (loop
        (if (not (ignore-errors
                   (search-forward-regexp "^(")
                   t))
            (return))
        (save-excursion
          (backward-char)
          (if
           (sexp-match-1 pattern)
           (throw 'done t)))))
  (goto-char (pop $$)) )

(defun find-sexp-match-2 (pattern)
  ;; top loop: iterate over top level forms
  (save-excursion
    (setf pattern (sexp-match-flatten pattern))
    (setf $ nil)
    (setf $$ nil)
    (catch 'done
      (goto-char 0)
      (loop
          (if (not (ignore-errors
                     (search-forward-regexp "^(")
                     t))
              (return))
          (save-excursion
            (backward-char)
            (if
             (sexp-match-1 pattern)
             (throw 'done t)))))
    (pop $$)) )

(defun sexp-match-1 (pattern)
  (loop
      (cond ((null pattern)
             ;; we reached the end, fine
             (push $ $$)
             (return t))
            ((stringp (first pattern))
             (if (ignore-errors
                   (forward-sexp)
                   (backward-sexp)
                   (looking-at (first pattern)))
                 (progn
                   (forward-sexp)
                   (pop pattern))
                 (return nil)))
            ((eq (first pattern) :down)
             (if (ignore-errors (down-list) t)
                 (pop pattern)
                 (return nil)))
            ((eq (first pattern) :up)
             (if (ignore-errors (forward-sexp) t)
                 (return nil))
             (if (ignore-errors (backward-up-list) (forward-sexp) t)
                 (pop pattern)
                 (return nil)))
            ((eq (first pattern) '_)
             (if (ignore-errors (forward-sexp) t)
                 (pop pattern)
                 (return nil)))
            ((eq (first pattern) '$)
             (if (ignore-errors (forward-sexp) t)
                 (backward-sexp))
             (setf $ (point))
             (pop pattern))
            ((eq (first pattern) '*)
             (loop
                 (save-excursion
                   (sexp-match-1 (cdr pattern)))
                 (if (not (ignore-errors (forward-sexp) t))
                     (return nil)))
             (return nil)))))

(defun sexp-match-flatten (pattern)
  (cond ((listp pattern)
         (copy-list
          (append '(:down)
                  (mapcan #'sexp-match-flatten pattern)
                  '(:up))))
        (t
         (list pattern))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This is the pure Horror, therefore I'll do an implementation from
;; scratch.

(defvar gb-lisp-definitions nil)

(defun edit-definitions-lisp (symbol type &optional stay search locator)
  (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 ((res
         (car
          (read-from-string
           (ilisp-send
            (format "(ilisp::source-file-2 \"%s\" \"%s\" \"%s\")"
                    (lisp-symbol-name symbol)
                    (lisp-symbol-package symbol)
                    type)
            (concat "Finding " type " " (lisp-symbol-name symbol) " definitions")
            'source )))))
    (setf gb-lisp-definitions res)
    (next-definition-lisp nil nil) ))

(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")
  (let ((def (pop gb-lisp-definitions)))
    (if def
        (progn
          (let ((file (first def))
                (pattern (second def))
                (name (third def)))
            (find-file file)
            (let ((p (find-sexp-match-2 pattern)))
              (if p
                  (progn
                    (goto-char p)
                    (message "Found, %d to go."
                             (length gb-lisp-definitions) ))
                  (progn
                    (message "Not found, burried in macro? %d to go."
                             (length gb-lisp-definitions)))))))
        (progn
          (message "No more definitions") ))))