Matching parentheses in Guile

[Jim Blandy <jimb@red-bean.com>]

Greg Harvey has written a patch to get Guile to do parenthesis
matching using a stock readline library.  I can't commit this change
until the FSF gets a copyright assignment from Greg, but in the
mean time, I thought people might appreciate it.  (I certainly do. :) )


1998-11-24  Jim Blandy  <jimb@zwingli.cygnus.com>

	Match parentheses.  (Contributed by Greg Harvey --- thanks!)
	* readline.c: #include "iselect.h".
	(scm_readline_opts): Add "bounce-parens" option.
	(match_paren, find_matching_paren, init_bouncing_parens): New
	functions.
	* readline.h: (SCM_N_READLINE_OPTIONS): Update.

	* readline.c (in_readline, reentry_barrier_mutex): Make these
	static.

Index: readline.c
===================================================================
RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/readline.c,v
retrieving revision 1.15
diff -c -r1.15 readline.c
*** readline.c	1998/11/19 04:48:50	1.15
--- readline.c	1998/11/24 19:59:23
***************
*** 50,60 ****
  #include <readline/readline.h>
  #include <readline/history.h>
  
  scm_option scm_readline_opts[] = {
    { SCM_OPTION_BOOLEAN, "history-file", 1,
      "Use history file." },
    { SCM_OPTION_INTEGER, "history-length", 200,
!     "History length." }
  };
  
  extern void stifle_history (int max);
--- 50,66 ----
  #include <readline/readline.h>
  #include <readline/history.h>
  
+ #include <sys/time.h>
+ #include "iselect.h"
+ 
+ 
  scm_option scm_readline_opts[] = {
    { SCM_OPTION_BOOLEAN, "history-file", 1,
      "Use history file." },
    { SCM_OPTION_INTEGER, "history-length", 200,
!     "History length." },
!   { SCM_OPTION_BOOLEAN, "bounce-parens", 1,
!     "Match closing parenthesis/brackets to opening ones."}
  };
  
  extern void stifle_history (int max);
***************
*** 155,163 ****
  
  SCM_PROC (s_readline, "readline", 0, 4, 0, scm_readline);
  
! int in_readline = 0;
  #ifdef USE_THREADS
! scm_mutex_t reentry_barrier_mutex;
  #endif
  
  static void
--- 161,169 ----
  
  SCM_PROC (s_readline, "readline", 0, 4, 0, scm_readline);
  
! static int in_readline = 0;
  #ifdef USE_THREADS
! static scm_mutex_t reentry_barrier_mutex;
  #endif
  
  static void
***************
*** 360,365 ****
--- 366,458 ----
      }
  }
  
+ /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
+ 
+ static void match_paren(int x, int k);
+ static int find_matching_paren(int k);
+ static void init_bouncing_parens();
+ 
+ static void
+ init_bouncing_parens()
+ {
+   if(strncmp(rl_get_keymap_name(rl_get_keymap()), "vi", 2)) {
+     rl_bind_key(')', match_paren);
+     rl_bind_key(']', match_paren);
+     rl_bind_key('}', match_paren);
+   }
+ }
+ 
+ static int
+ find_matching_paren(int k)
+ {
+   register int i;
+   register char c = 0;
+   int end_parens_found = 0;
+ 
+   /* Choose the corresponding opening bracket.  */
+   if (k == ')') c = '(';
+   else if (k == ']') c = '[';
+   else if (k == '}') c = '{';
+ 
+   for (i=rl_point-2; i>=0; i--)
+     {
+       /* Is the current character part of a character literal?  */
+       if (i - 2 >= 0
+ 	  && rl_line_buffer[i - 1] == '\\'
+ 	  && rl_line_buffer[i - 2] == '#')
+ 	;
+       else if (rl_line_buffer[i] == k)
+ 	end_parens_found++;
+       else if (rl_line_buffer[i] == '"')
+ 	{
+ 	  /* Skip over a string literal.  */
+ 	  for (i--; i >= 0; i--)
+ 	    if (rl_line_buffer[i] == '"'
+ 		&& ! (i - 1 >= 0
+ 		      && rl_line_buffer[i - 1] == '\\'))
+ 	      break;
+ 	}
+       else if (rl_line_buffer[i] == c)
+ 	{
+ 	  if (end_parens_found==0) return i;
+ 	  else --end_parens_found;
+ 	}
+     }
+   return -1;
+ }
+ 
+ static void
+ match_paren(int x, int k)
+ {
+   int tmp;
+   fd_set readset;
+   struct timeval timeout;
+   
+   rl_insert(x, k);
+   if (!SCM_READLINE_BOUNCE_PARENS_P)
+     return;
+ 
+   /* Did we just insert a quoted paren?  If so, then don't bounce.  */
+   if (rl_point - 1 >= 1
+       && rl_line_buffer[rl_point - 2] == '\\')
+     return;
+ 
+   timeout.tv_sec = 0;
+   timeout.tv_usec = 500000;
+   FD_ZERO(&readset);
+   FD_SET(fileno(rl_instream), &readset);
+   
+   if(rl_point > 1) {
+     tmp = rl_point;
+     rl_point = find_matching_paren(k);
+     if(rl_point > -1) {
+       rl_redisplay();
+       scm_internal_select(1, &readset, NULL, NULL, &timeout);
+     }
+     rl_point = tmp;
+   }
+ }
+ 
  
  void
  scm_init_readline ()
***************
*** 377,382 ****
--- 470,476 ----
    scm_init_opts (scm_readline_options,
  		 scm_readline_opts,
  		 SCM_N_READLINE_OPTIONS);
+   init_bouncing_parens();
    scm_add_feature ("readline");
  }
  
Index: readline.h
===================================================================
RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/readline.h,v
retrieving revision 1.7
diff -c -r1.7 readline.h
*** readline.h	1998/11/09 14:15:30	1.7
--- readline.h	1998/11/24 19:59:23
***************
*** 48,54 ****
  
  #define SCM_HISTORY_FILE_P     scm_readline_opts[0].val
  #define SCM_HISTORY_LENGTH     scm_readline_opts[1].val
! #define SCM_N_READLINE_OPTIONS 2
  
  extern SCM scm_readline_options (SCM setting);
  extern SCM scm_readline (SCM txt, SCM inp, SCM outp, SCM read_hook);
--- 48,55 ----
  
  #define SCM_HISTORY_FILE_P     scm_readline_opts[0].val
  #define SCM_HISTORY_LENGTH     scm_readline_opts[1].val
! #define SCM_READLINE_BOUNCE_PARENS_P scm_readline_opts[2].val
! #define SCM_N_READLINE_OPTIONS 3
  
  extern SCM scm_readline_options (SCM setting);
  extern SCM scm_readline (SCM txt, SCM inp, SCM outp, SCM read_hook);