diff options
| author | Neil Jerram <neil@ossau.uklinux.net> | 2007-02-18 23:03:35 +0000 |
|---|---|---|
| committer | Neil Jerram <neil@ossau.uklinux.net> | 2007-02-18 23:03:35 +0000 |
| commit | 169ccff576c7c7d6e9c4b77deb65241ebaa3ee71 (patch) | |
| tree | d43b70ce706842458fbd19042c2085ba6d8eea4d /ice-9/gds-client.scm | |
| parent | e6ee0d484f81834bdb291990ddc5b90f94264eee (diff) | |
| download | guile-169ccff576c7c7d6e9c4b77deb65241ebaa3ee71.tar.gz | |
(connect-to-gds): Break generation of client name
into ...
(client-name): New procedure.
(client-name): Put something from (program-arguments) in the
client name that GDS displays in Emacs.
(connect-to-gds, client-name): Add application-name arg to allow
caller to specify client name.
Diffstat (limited to 'ice-9/gds-client.scm')
| -rwxr-xr-x | ice-9/gds-client.scm | 16 |
1 files changed, 14 insertions, 2 deletions
diff --git a/ice-9/gds-client.scm b/ice-9/gds-client.scm index 8c7bdc742..7e6e524e5 100755 --- a/ice-9/gds-client.scm +++ b/ice-9/gds-client.scm @@ -170,7 +170,7 @@ (safely-handle-nondebug-protocol protocol) (loop (gds-debug-read)))))))) -(define (connect-to-gds) +(define (connect-to-gds . application-name) (or gds-port (begin (set! gds-port @@ -190,7 +190,19 @@ s) (lambda _ #f))) (error "Couldn't connect to GDS by TCP or Unix domain socket"))) - (write-form (list 'name (getpid) (format #f "PID ~A" (getpid))))))) + (write-form (list 'name (getpid) (apply client-name application-name)))))) + +(define (client-name . application-name) + (let loop ((args (append application-name (program-arguments)))) + (if (null? args) + (format #f "PID ~A" (getpid)) + (let ((arg (car args))) + (cond ((string-match "^(.*[/\\])?guile(\\..*)?$" arg) + (loop (cdr args))) + ((string-match "^-" arg) + (loop (cdr args))) + (else + (format #f "~A (PID ~A)" arg (getpid)))))))) (if (not (defined? 'make-mutex)) (begin |