[MIT-Scheme-users] Edwin command to quickly view source of a Scheme procedure

[Rich Loveland]

Hello,

I've written an Edwin command that can be used in Scheme-mode or REPL
buffers to pop open a temp buffer with the source of the procedure at
point.  It's similar to functionality provided by SLIME for Common
Lisp programming under Emacs.

I'd like to get feedback from users and then polish up the
implementation to submit a patch to the developers.

If you have used SLIME and already know what this kind of
functionality is about, the code is at the bottom of this message: the
procedures are THING-AT-POINT and %SHOW-DEFINITION.  The Edwin command
is SHOW-DEFINITION-AT-POINT.

Here's how it works:

In the diagram, assume A is an Edwin buffer in Scheme or REPL mode.

 ----
|    |
| A  |
|    |
 ----

If your cursor is on a Scheme procedure name such as
WITH-OUTPUT-TO-STRING, run the command 'M-X SHOW-DEFINITION-AT-POINT'
(which I've bound to 'M-.' for convenience, since I prefer it to
FIND-TAG).  This pops open a temporary buffer displaying the source of
WITH-OUTPUT-TO-STRING as reported by PP (not a Scheme source code
file).  Your Edwin frame now looks like this, where T is the pop-up
buffer showing the code:

 ----
| A  |
 ----
| T  |
 ----

You can flush T with the space bar if you want, or leave it open and
use the SHOW-DEFINITION-AT-POINT command "recursively" on the code
inside T to keep exploring.  Each time you call
SHOW-DEFINITION-AT-POINT, a new buffer is opened; the name of the
buffer is the name of the procedure whose source it contains.

Here's the code if you would like to try it out (open to style or
other suggestions about any of the below):

;; ------------------------------------------------------------------

(ge '(edwin))

;; THING-AT-POINT is used to grab the Scheme symbol at point, but I've
;; also been using it to hack up 'find-file-at-point' and other
;; commands from Emacs-land, hence the ()<>'" munging.

(define (thing-at-point)
  (let ((out))
    (save-excursion
     (lambda ()
       (let* ((beg (or (re-search-backward
                        (regexp-group "^" " +" "<" "(" "\"") (current-point))
                       (begin (ref-command beginning-of-line) (current-point))))
              (end (or (re-search-forward
                        (regexp-group "$" " +" ">" ")" "\"") (current-point))
                       (begin (ref-command end-of-line) (current-point)))))
         (if (and beg end)
             (let* ((raw (region->string (make-region beg end)))
                    (deparenned
                     (string-replace (string-replace raw #\( #\ ) #\) #\ ))
                    (dequoted
                     (string-replace (string-replace deparenned #\' #\ ) #\" #\ 
))
                    (debracketed
                     (string-replace (string-replace dequoted #\< #\ ) #\> #\ ))
                    (trimmed (string-trim debracketed)))
               (set! out trimmed))
             (set! out "")))))
    out))

(define-command show-definition-at-point
  "Show the definition of the procedure at point."
  ()
  (lambda ()
    (let* ((definition (thing-at-point)))
      (%show-definition definition))))

; %SHOW-DEFINITION is not really meant to be used by anything other
; than the above command, hence the '%'.

(define (%show-definition procname)
  (let* ((proc (environment-lookup
                (evaluation-environment)
                ;; (nearest-repl/environment) ; should we use this instead?
                (string->symbol procname)))
         (source (with-output-to-string (lambda ()
                                          (pp proc)))))
    (with-output-to-temporary-buffer procname
      '(read-only flush-on-space)
      (lambda ()
        (display source)))))

;; Use these if you prefer them to FIND-TAG.

(define-key 'scheme '(#\M-.) 'show-definition-at-point)
(define-key 'inferior-repl '(#\M-.) 'show-definition-at-point)

; temp buffer is opened in fundamental mode, but should really be in
; Scheme mode

(define-key 'fundamental '(#\M-.) 'show-definition-at-point)