Guile with dynamic readline - #2

[Martin Baulig <martin@home-of-linux.org>]

Hello,

This is the second version of my dynamic readline patch, it requires my
last `scm_add_feature("gnu")' patch to be applied first.

When you give configure the --with-readline parameter, this will create a
libguile-readline.so which can be linked dynamically.

Rather than requiring the user to put anything in his ~/.guile or to give
the guile interpreter any parameters, this enables readline support by
default if it's a GPLed interpreter and the current input port is a terminal.

For the end user that means that he'll get a guile interpreter with full
readline support without any need to worry about legal implications - if
someone ever uses the license exception, readline will not be linked in.

Patch against current anoncvs is below - please let me know if you want to
include it in the guile distribution and I'll add the required things such
as ChangeLog and documentation ...

Martin

Index: configure.in
===================================================================
RCS file: /cvs/guile/guile/guile-core/configure.in,v
retrieving revision 1.81
diff -u -u -r1.81 configure.in
--- configure.in	1999/05/02 17:16:26	1.81
+++ configure.in	1999/06/04 23:51:51
@@ -93,6 +93,45 @@
     AC_CHECK_LIB(socket, connect)
 fi
 
+AC_ARG_WITH([readline],
+  [  --with-readline         use Readline library for command-line editing],
+  [], [with_readline=no])
+
+if test "x$with_readline" = "xyes"; then
+  dnl Add them to READLINE_LIBS since we do not like against it.
+  READLINE_LIBS=
+  for termlib in ncurses termcap ; do
+    AC_CHECK_LIB(${termlib}, tgoto, 
+                 [READLINE_LIBS="-l${termlib} $READLINE_LIBS"; break])
+  done
+  AC_CHECK_LIB(readline, main, [READLINE_LIBS="-lreadline $READLINE_LIBS"])
+  AC_CHECK_FUNCS(rl_clear_signals rl_cleanup_after_signal)
+  AC_SUBST(READLINE_LIBS)
+
+  AC_CACHE_CHECK([for rl_getc_function pointer in readline],
+		 ac_cv_var_rl_getc_function,
+		 [AC_TRY_LINK([
+  #include <stdio.h>
+  #include <readline/readline.h>],
+			      [rl_getc_function;],
+			      [ac_cv_var_rl_getc_function=yes],
+			      [ac_cv_var_rl_getc_function=no])])
+  if test "${ac_cv_var_rl_getc_function}" = "yes"; then
+    AC_DEFINE(HAVE_RL_GETC_FUNCTION)
+  else
+    with_readline=no
+  fi
+
+  if test $ac_cv_lib_readline_main = yes \
+          -a $ac_cv_var_rl_getc_function = no; then
+    AC_MSG_WARN([Warning: libreadline is too old on your system.  You need])
+    AC_MSG_WARN([readline version 2.1 or later.])
+  fi
+
+fi
+
+AM_CONDITIONAL(WITH_READLINE, test "x$with_readline" = "xyes")
+
 # Checks for dynamic linking
 
 if test "$enable_dynamic_linking" = "yes"; then
Index: ice-9/readline.scm
===================================================================
RCS file: /cvs/guile/guile/guile-core/ice-9/readline.scm,v
retrieving revision 1.11
diff -u -u -r1.11 readline.scm
--- readline.scm	1998/11/09 15:51:30	1.11
+++ readline.scm	1999/06/04 23:51:51
@@ -21,6 +21,7 @@
 ;;;; Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>.
 
 (define-module (ice-9 readline)
+  :use-module (guile readline)
   :use-module (ice-9 session)
   :use-module (ice-9 regex))
 
@@ -148,3 +149,79 @@
 		   retval))))))
 
 (set! *readline-completion-function* apropos-completion-function)
+
+;; this is just (scm-style-repl) with a wrapper to install and remove 
+;; signal handlers.
+(define-public (readline-top-repl) 
+
+  ;; Load emacs interface support if emacs option is given.
+  (if (and (module-defined? the-root-module 'use-emacs-interface)
+	   use-emacs-interface)
+      (load-emacs-interface))
+
+  ;; Place the user in the guile-user module.
+  (define-module (guile-user))
+
+  (let ((old-handlers #f)
+	(signals `((,SIGINT . "User interrupt")
+		   (,SIGFPE . "Arithmetic error")
+		   (,SIGBUS . "Bad memory access (bus error)")
+		   (,SIGSEGV . "Bad memory access (Segmentation violation)"))))
+
+    (dynamic-wind
+
+     ;; call at entry
+     (lambda ()
+       (let ((make-handler (lambda (msg)
+			     (lambda (sig)
+			       (save-stack %deliver-signals)
+			       (scm-error 'signal
+					  #f
+					  msg
+					  #f
+					  (list sig))))))
+	 (set! old-handlers
+	       (map (lambda (sig-msg)
+		      (sigaction (car sig-msg)
+				 (make-handler (cdr sig-msg))))
+		    signals))))
+
+     ;; the protected thunk.
+     (lambda ()
+
+       ;; If we've got readline, use it to prompt the user.  This is a
+       ;; kludge, but we'll fix it soon.  At least we only get
+       ;; readline involved when we're actually running the repl.
+       (if (and (memq 'readline *features*)
+		(isatty? (current-input-port))
+		(not (and (module-defined? the-root-module
+					   'use-emacs-interface)
+			  use-emacs-interface)))
+	   (let ((read-hook (lambda () (run-hook before-read-hook))))
+	     (set-current-input-port (readline-port))
+	     (set! repl-reader
+		   (lambda (prompt)
+		     (dynamic-wind
+		      (lambda ()
+			(set-readline-prompt! prompt)
+			(set-readline-read-hook! read-hook))
+		      (lambda () (read))
+		      (lambda ()
+			(set-readline-prompt! "")
+			(set-readline-read-hook! #f)))))))
+       (let ((status (scm-style-repl)))
+	 (run-hook exit-hook)
+	 status))
+
+     ;; call at exit.
+     (lambda ()
+       (map (lambda (sig-msg old-handler)
+	      (if (not (car old-handler))
+		  ;; restore original C handler.
+		  (sigaction (car sig-msg) #f)
+		  ;; restore Scheme handler, SIG_IGN or SIG_DFL.
+		  (sigaction (car sig-msg)
+			     (car old-handler)
+			     (cdr old-handler))))
+			 signals old-handlers)))))
+
Index: libguile/Makefile.am
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/Makefile.am,v
retrieving revision 1.65
diff -u -u -r1.65 Makefile.am
--- Makefile.am	1999/05/23 09:53:29	1.65
+++ Makefile.am	1999/06/04 23:51:52
@@ -28,7 +28,17 @@
 
 ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(PROC\|PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/'
 
-lib_LTLIBRARIES = libguile.la
+if WITH_READLINE
+readline_ltlibraries = libguile-readline.la
+readline_built_sources = readline.x
+readline_extra_dist = boot-readline.scm
+else
+readline_ltlibraries =
+readline_built_sources =
+readline_extra_dist =
+endif
+
+lib_LTLIBRARIES = libguile.la $(readline_ltlibraries)
 bin_PROGRAMS = guile
 
 guile_SOURCES = guile.c
@@ -61,12 +71,19 @@
     root.x scmsigs.x script.x simpos.x smob.x socket.x sort.x		\
     srcprop.x stackchk.x stacks.x stime.x strings.x strop.x strorder.x	\
     strports.x struct.x symbols.x tag.x threads.x throw.x unif.x	\
-    variable.x vectors.x version.x vports.x weaks.x
+    variable.x vectors.x version.x vports.x weaks.x \
+    $(readline_built_sources)
 
 EXTRA_libguile_la_SOURCES = _scm.h \
     strerror.c inet_aton.c putenv.c \
     threads.c alloca.c \
     regex-posix.c iselect.c
+
+libguile_readline_la_SOURCES = \
+    readline.c
+
+libguile_readline_la_LIBADD = @READLINE_LIBS@
+libguile_readline_la_LDFLAGS = -version-info 4:0 -export-dynamic
 
 ## This is kind of nasty... there are ".c" files that we don't want to
 ## compile, since they are #included in threads.c.  So instead we list
Index: libguile/readline.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/readline.c,v
retrieving revision 1.16
diff -u -u -r1.16 readline.c
--- readline.c	1999/02/06 17:10:00	1.16
+++ readline.c	1999/06/04 23:51:52
@@ -473,6 +473,13 @@
 		 SCM_N_READLINE_OPTIONS);
   init_bouncing_parens();
   scm_add_feature ("readline");
+  gh_new_procedure ("readline", scm_readline, 0, 4, 0);
+}
+
+void
+scm_boot_readline ()
+{
+  scm_register_module_xxx ("guile readline", scm_init_readline);
 }
 
 #endif 
Index: libguile/readline.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/readline.h,v
retrieving revision 1.8
diff -u -u -r1.8 readline.h
--- readline.h	1999/02/06 17:10:01	1.8
+++ readline.h	1999/06/04 23:51:53
@@ -58,5 +58,6 @@
 extern SCM scm_write_history (SCM file);
 extern SCM scm_filename_completion_function (SCM text, SCM continuep);
 extern void scm_init_readline (void);
+extern void scm_boot_readline (void);
 
 #endif

Index: boot-9.scm
===================================================================
RCS file: /cvs/guile/guile/guile-core/ice-9/boot-9.scm,v
retrieving revision 1.176
diff -u -u -r1.176 boot-9.scm
--- boot-9.scm	1999/05/02 17:27:05	1.176
+++ boot-9.scm	1999/06/05 17:02:04
@@ -3047,6 +3047,29 @@
   ;; Place the user in the guile-user module.
   (define-module (guile-user))
 
+  ;; If this is a GPLed guile interpreter and the current input port is
+  ;; a terminal, try to link in readline code ignoring all exceptions.
+  (if (and (feature? 'gnu) (isatty? (current-input-port)))
+      (catch #t
+	     (lambda ()
+	       (dynamic-call "scm_boot_readline"
+			     (dynamic-link "libguile-readline.so"))
+	       (if (isatty? (current-input-port))
+		   (save-module-excursion
+		    (lambda ()
+		      (define-module (guile)
+			:use-module (ice-9 readline))
+		      (define-module (guile-user)
+			:use-module (ice-9 readline))))))
+	     (lambda args
+	       (with-output-to-port (current-error-port)
+		 (lambda ()
+		   (display ";;; WARNING ")
+		   (display args)
+		   (newline)
+		   (display ";;; Readline support disabled.")
+		   (newline))))))
+  
   (let ((old-handlers #f)
 	(signals `((,SIGINT . "User interrupt")
 		   (,SIGFPE . "Arithmetic error")