mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 00:10:21 +02:00
Code Activity

(connect-to-gds): Break generation of client name

Browse source 
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.
This commit is contained in:
Neil Jerram 2007-02-18 23:03:35 +00:00
parent e6ee0d484f
commit 169ccff576
2 changed files with 24 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

10
ice-9/ChangeLog
View file

@ -1,3 +1,13 @@
2007-02-18 Neil Jerram <neil@ossau.uklinux.net>
* gds-client.scm (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.
2007-02-09 Ludovic Courtès <ludovic.courtes@laas.fr>
* Makefile.am (ice9_sources): Added `i18n.scm'.

16
ice-9/gds-client.scm
View file

@ -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