1% Here is a new version of isearch.sl reworked by John Burnell <johnb@whio.grace.cri.nz>.
2% This one is said to be more emacs-like.
3%% isearch.sl
4%% Routines here perform incremental forward/backward searches
5%%
6%% ESCAPE key aborts the search
7%% ENTER key finds next match
8%% DELETE key deletes last character entered and returns to previous point
9%%
10%%  "isearch_forward"	"^FIf"   setkey  %(sample bindings)
11%%  "isearch_backward"	"^FIb"   setkey
12
13variable Isearch_Last_Search = Null_String;
14
15%% This code fragment checks to see what the isearch keys are bound to
16variable Isearch_Forward_Char = 19;   %^S
17variable Isearch_Backward_Char = 18;  %^R
18
19define get_bound_key (search_func, default)
20{
21   variable n, key;
22   if (n = which_key (search_func), n)
23     {
24	key = (); n--;
25	if (strlen (key) == 2)
26	  {
27	     if (key [0] == '^')
28	       return (key [1] - '@');
29	  }
30     }
31   return default;
32}
33Isearch_Forward_Char = get_bound_key ("isearch_forward", 19);
34Isearch_Backward_Char = get_bound_key ("isearch_backward", 18);
35
36define isearch_simple_search (dir)
37{
38   variable fun, prompt;
39
40   prompt = "Search:";
41   fun = &fsearch;
42
43   if (dir < 0)
44     {
45	prompt = "Search Backwards:";
46	fun = &bsearch;
47     }
48
49   Isearch_Last_Search = read_mini (prompt, Isearch_Last_Search, Null_String);
50
51   !if (@fun (Isearch_Last_Search))
52     error ("Not Found.");
53}
54
55#ifdef KANJI
56define is_2ndkanji(str)
57{
58   variable n = strlen (str);
59   variable m = 0;
60
61%   if(n < 2)	return 0;
62   while(m < n) {
63	if(iskanji(str[m])) {
64		m++;
65		if((m + 1) == n) return TRUE;
66	}
67	m++;
68   }
69   return FALSE;
70}
71#endif
72
73define isearch_del (str)
74{
75   variable n = strlen (str);
76   if (n) {
77#ifdef KANJI
78	if (is_2ndkanji(str)) {
79	    str = substr (str, 1, n - 1);
80	    n--;
81	}
82#endif
83	str = substr (str, 1, n - 1);
84   }
85   str;
86}
87
88
89define isearch_dir (dir)
90{
91   variable prompt, str = Null_String;
92   variable c, nc, m, first = 1;
93   variable len = 0;
94
95  % This is tricky.  I am leaving a 1 or a 0 on the stack which indicates
96  % whether or not a character is attached to a mark.  The number of ones
97  % and zeros on the stack should match the value of m.
98  % These 0s and 1s are used when unwinding the search stack
99  % Since a mark was pushed and not attached to a character, push 0
100
101   push_mark ();
102   0;
103   m = 1;
104   nc = 0;
105   ERROR_BLOCK { loop (m) { pop (); pop_mark (0);}} %make sure we pop marks
106
107   forever {
108      if (dir == 1)
109      	prompt = "Isearch forward: ";
110      else
111      	prompt = "Isearch Backward: ";
112      message (prompt + str);
113      push_spot ();
114      if ((dir > 0) and looking_at (str))
115	{
116	   go_right (strlen (str));
117	}
118      update (0);
119      pop_spot ();
120
121      c = getkey();
122      switch (c)
123	{ case 27 and first : isearch_simple_search (dir); break;}
124        { case Isearch_Forward_Char :       % ^S
125	   push_mark (); ++m; 0;             % mark not attached to char!
126	   if (dir < 0) {
127	      dir = 1;
128	   } else {
129	      go_right_1 ();
130	      !if (strlen (str))
131		{
132		   str = Isearch_Last_Search;
133		   len = strlen (str);
134		}
135	   }
136        }
137        { case Isearch_Backward_Char :  %^R
138	   push_mark (); 0; ++m;         % mark not attached to char!
139	   if (dir > 0) {
140	      dir = -1;
141	      c = ' ';                      % use this to fool test (*) below
142	   } else  {
143	      !if (strlen (str)) str = Isearch_Last_Search;
144	   }
145        }
146        { case 127 :
147
148	  if (m) {
149	    if (()) {
150	      if (strlen (str)) str = isearch_del (str); % delete char
151	    }
152	    --m; pop_mark (1);     % top of stack already popped
153	  }
154	  continue;
155        }
156        { case 7 : % ^G go back to start
157	   loop (m - 1) {pop (); pop_mark (0);}  % pop marks
158	   pop ();
159	   pop_mark (1);                      % go to start of search
160	   beep ();
161	   return;
162	}
163#ifdef KANJI
164	{ iskanji(c) :                       % Kanji
165	   str = strcat (str, char (c));     %
166	   nc = getkey();
167	   str = strcat (str, char (nc));     %
168	   1; push_mark (); ++m;
169	}
170#endif
171	{
172	 case '\r' and first:
173	   loop (m)
174	     {
175		pop ();
176		pop_mark (0);
177	     }
178	   m = 0;
179	   if (dir > 0) return search_forward ();
180	   else return search_backward ();
181	}
182
183	{
184	 case '\e':
185	   if (input_pending (3))
186	     ungetkey (c);
187	   break;
188	}
189
190        { c < 32 :
191	   ungetkey (c);
192	   break; 	       % terminate search
193	}
194
195	{ str += char (c);             % any other char
196	   1; push_mark(); ++m;	       % push 1 and mark
197	}
198
199      first = 0;
200
201% test (*), see ^R switch above
202      if ((dir < 0) and (m > 1) and looking_at (str) and (c >= ' '))
203	continue;
204
205      if (dir == 1) fsearch (str);
206      else bsearch (str);
207      if (())
208	len = 0;
209%	len = strlen (str);		% Why ?? (ky)
210      else
211	{
212 	   if (c == Isearch_Forward_Char) go_left_1();
213	   flush (str + " not found.");
214	   beep ();
215	   () = input_pending (10);
216	   if (() == 1) str = isearch_del (str);
217	   --m; pop_mark (0);     % top of stack already popped in test
218	}
219      nc = 0;
220   }
221
222   EXECUTE_ERROR_BLOCK;
223   if (strlen (str))
224     Isearch_Last_Search = str;
225   if (dir == 1)
226     go_right (strlen (str) - len);
227   message ("Done.");
228
229   flush_input ();
230}
231
232static variable save_abort;
233
234define isearch_forward()
235{
236   save_abort = IGNORE_USER_ABORT;
237   IGNORE_USER_ABORT = 1;
238   isearch_dir (1);
239   IGNORE_USER_ABORT = save_abort;
240}
241
242define isearch_backward()
243{
244   save_abort = IGNORE_USER_ABORT;
245   IGNORE_USER_ABORT = 1;
246   isearch_dir (-1);
247   IGNORE_USER_ABORT = save_abort;
248}
249
250
251