1 
2 /******************************************************************************
3 * MODULE     : tm_dialogue.cpp
4 * DESCRIPTION: Dialogues
5 * COPYRIGHT  : (C) 1999  Joris van der Hoeven
6 *******************************************************************************
7 * This software falls under the GNU general public license version 3 or later.
8 * It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
9 * in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
10 ******************************************************************************/
11 
12 #include "tm_frame.hpp"
13 #include "tm_window.hpp"
14 #include "convert.hpp"
15 #include "file.hpp"
16 #include "analyze.hpp"
17 #include "message.hpp"
18 #include "dictionary.hpp"
19 
20 /******************************************************************************
21 * Dialogues
22 ******************************************************************************/
23 
24 class dialogue_command_rep: public command_rep {
25   server_rep* sv;
26   object      fun;
27   scheme_tree p;
28   int         nr_args;
29 
30 public:
dialogue_command_rep(server_rep * sv2,object fun2,int nr_args2)31   dialogue_command_rep (server_rep* sv2, object fun2, int nr_args2):
32     sv (sv2), fun (fun2), nr_args (nr_args2) {}
dialogue_command_rep(server_rep * sv2,object fun2,scheme_tree p2)33   dialogue_command_rep (server_rep* sv2, object fun2, scheme_tree p2):
34     sv (sv2), fun (fun2), p (p2), nr_args (N(p2)) {}
35   void apply ();
print(tm_ostream & out)36   tm_ostream& print (tm_ostream& out) {
37     return out << "Dialogue"; }
38 };
39 
40 static string
41 get_type (scheme_tree p, int i);
42 
43 void
apply()44 dialogue_command_rep::apply () {
45   int i;
46   object cmd  = null_object ();
47   object learn= null_object ();
48   for (i=nr_args-1; i>=0; i--) {
49     string s_arg;
50     sv->dialogue_inquire (i, s_arg);
51     if (s_arg == "#f") {
52       exec_delayed (scheme_cmd ("(dialogue-end)"));
53       return;
54     }
55     object arg= string_to_object (s_arg);
56     cmd= cons (arg, cmd);
57     if (!is_empty (p) && get_type (p, i) == "password")
58       learn= cons (cons (object (as_string (i)), object ("")), learn);
59     else
60       learn= cons (cons (object (as_string (i)), arg), learn);
61     //call ("learn-interactive-arg", fun, object (i), arg);
62   }
63   call ("learn-interactive", fun, learn);
64   cmd= cons (fun, cmd);
65   exec_delayed (scheme_cmd ("(dialogue-end)"));
66   exec_delayed (scheme_cmd (cmd));
67 }
68 
69 command
dialogue_command(server_rep * sv,object fun,scheme_tree p)70 dialogue_command (server_rep* sv, object fun, scheme_tree p) {
71   return tm_new<dialogue_command_rep> (sv, fun, p);
72 }
73 
74 command
dialogue_command(server_rep * sv,object fun,int n)75 dialogue_command (server_rep* sv, object fun, int n) {
76   return tm_new<dialogue_command_rep> (sv, fun, n);
77 }
78 
79 void
dialogue_start(string name,widget wid)80 tm_frame_rep::dialogue_start (string name, widget wid) {
81   if (is_nil (dialogue_win)) {
82     string lan= get_output_language ();
83     if (lan == "russian") lan= "english";
84     name= translate (name, "english", lan);
85     dialogue_wid= wid;
86     dialogue_win= plain_window_widget (dialogue_wid, name);
87 
88     widget win= concrete_window () -> win;
89     SI ox, oy, dx, dy, ex= 0, ey= 0;
90     get_position (win, ox, oy);
91     get_size (win, dx, dy);
92     get_size (dialogue_win, ex, ey);
93     ox += (dx - ex) >> 1;
94     oy -= (dy - ey) >> 1;
95     set_position (dialogue_win, ox, oy);
96     set_visibility (dialogue_win, true);
97   }
98 }
99 
100 void
dialogue_inquire(int i,string & arg)101 tm_frame_rep::dialogue_inquire (int i, string& arg) {
102   if (i == 0) arg= get_string_input (dialogue_wid);
103   else {
104     widget field_i= get_form_field (dialogue_wid, i);
105     arg= get_string_input (field_i);
106   }
107 }
108 
109 void
dialogue_end()110 tm_frame_rep::dialogue_end () {
111   if (!is_nil (dialogue_win)) {
112     set_visibility (dialogue_win, false);
113     destroy_window_widget (dialogue_win);
114     dialogue_win= widget ();
115     dialogue_wid= widget ();
116   }
117 }
118 
119 static int
gcd(int i,int j)120 gcd (int i, int j) {
121   if (i<j)  return gcd (j, i);
122   if (j==0) return i;
123   return gcd (j, i%j);
124 }
125 
126 void
choose_file(object fun,string title,string type,string prompt,url name)127 tm_frame_rep::choose_file (object fun, string title, string type,
128 			   string prompt, url name) {
129   command  cb  = dialogue_command (get_server(), fun, 1);
130   widget   wid = file_chooser_widget (cb, type, prompt);
131   if (!is_scratch (name)) {
132     set_directory (wid, as_string (head (name)));
133     if ((type != "image") && (type != "")) {
134       url u= tail (name);
135       string old_suf= suffix (u);
136       string new_suf= format_to_suffix (type);
137       if ((suffix_to_format (suffix (u)) != type) &&
138 	  (old_suf != "") && (new_suf != ""))
139 	{
140 	  u= unglue (u, N(old_suf) + 1);
141 	  u= glue (u, "." * new_suf);
142 	}
143       set_file (wid, as_string (u));
144     }
145   }
146   else set_directory (wid, ".");
147   dialogue_start (title, wid);
148   if (type == "directory") send_keyboard_focus (get_directory (dialogue_wid));
149   else send_keyboard_focus (get_file (dialogue_wid));
150 }
151 
152 /******************************************************************************
153 * Interactive commands
154 ******************************************************************************/
155 
156 static string
get_prompt(scheme_tree p,int i)157 get_prompt (scheme_tree p, int i) {
158   if (is_atomic (p[i]) && is_quoted (p[i]->label))
159     return translate (scm_unquote (p[i]->label));
160   else if (is_tuple (p[i]) && N(p[i])>0) {
161     if (is_atomic (p[i][0]) && is_quoted (p[i][0]->label))
162       return translate (scm_unquote (p[i][0]->label));
163     return translate (scheme_tree_to_tree (p[i][0]));
164   }
165   return translate ("Input:");
166 }
167 
168 static string
get_type(scheme_tree p,int i)169 get_type (scheme_tree p, int i) {
170   if (is_tuple (p[i]) && N(p[i])>1 &&
171       is_atomic (p[i][1]) && is_quoted (p[i][1]->label))
172     return scm_unquote (p[i][1]->label);
173   return "string";
174 }
175 
176 static array<string>
get_proposals(scheme_tree p,int i)177 get_proposals (scheme_tree p, int i) {
178   array<string> a;
179   if (is_tuple (p[i]) && N(p[i]) >= 2) {
180     int j, n= N(p[i]);
181     for (j=2; j<n; j++)
182       if (is_atomic (p[i][j]) && is_quoted (p[i][j]->label))
183 	a << scm_unquote (p[i][j]->label);
184   }
185   return a;
186 }
187 
188 class interactive_command_rep: public command_rep {
189   server_rep*   sv;   // the underlying server
190   tm_window     win;  // the underlying TeXmacs window
191   object        fun;  // the function which is applied to the arguments
192   scheme_tree   p;    // the interactive arguments
193   int           i;    // counter where we are
194   array<string> s;    // feedback from interaction with user
195 
196 public:
interactive_command_rep(server_rep * sv2,tm_window win2,object fun2,scheme_tree p2)197   interactive_command_rep (
198     server_rep* sv2, tm_window win2, object fun2, scheme_tree p2):
199       sv (sv2), win (win2), fun (fun2), p (p2), i (0), s (N(p)) {}
200   void apply ();
print(tm_ostream & out)201   tm_ostream& print (tm_ostream& out) {
202     return out << "interactive command " << p; }
203 };
204 
205 void
apply()206 interactive_command_rep::apply () {
207   if ((i>0) && (s[i-1] == "#f")) return;
208   if (i == N(p)) {
209     object learn= null_object ();
210     array<object> params (N(p));
211     for (i=N(p)-1; i>=0; i--) {
212       params[i]= string_to_object (s[i]);
213       if (get_type (p, i) == "password")
214 	learn= cons (cons (object (as_string (i)), object ("")), learn);
215       else
216 	learn= cons (cons (object (as_string (i)), params[i]), learn);
217     }
218     call ("learn-interactive", fun, learn);
219     string ret= object_to_string (call (fun, params));
220     if (ret != "" && ret != "<unspecified>" && ret != "#<unspecified>")
221       sv->set_message (verbatim (ret), "interactive command");
222   }
223   else {
224     s[i]= string ("");
225     string prompt= get_prompt (p, i);
226     string type  = get_type (p, i);
227     array<string> proposals= get_proposals (p, i);
228     win->interactive (prompt, type, proposals, s[i], this);
229     i++;
230   }
231 }
232 
233 void
interactive(object fun,scheme_tree p)234 tm_frame_rep::interactive (object fun, scheme_tree p) {
235   ASSERT (is_tuple (p), "tuple expected");
236   if (N(p) == 0) {
237     string ret= object_to_string (call (fun));
238     if (ret != "" && ret != "<unspecified>" && ret != "#<unspecified>")
239       set_message (verbatim (ret), "interactive command");
240   }
241   else if (get_preference ("interactive questions") == "popup" ||
242 	   (is_aux_buffer (get_current_buffer_safe ()) &&
243             !is_rooted_tmfs (get_current_buffer_safe (), "part"))) {
244     int i, n= N(p);
245     array<string> prompts (n);
246     for (i=0; i<n; i++)
247       prompts[i]= get_prompt (p, i);
248     command cb= dialogue_command (get_server(), fun, p);
249     widget wid= inputs_list_widget (cb, prompts);
250     for (i=0; i<n; i++) {
251       widget input_wid= get_form_field (wid, i);
252       set_input_type (input_wid, get_type (p, i));
253       array<string> proposals= get_proposals (p, i);
254       int j, k= N(proposals);
255       if (k > 0) set_string_input (input_wid, proposals[0]);
256       for (j=0; j<k; j++) add_input_proposal (input_wid, proposals[j]);
257     }
258     string title= translate ("Enter data");
259     if (ends (prompts[0], "?")) title= translate ("Question");
260     dialogue_start (title, wid);
261     send_keyboard_focus (get_form_field (dialogue_wid, 0));
262   }
263   else {
264     if (concrete_window () -> get_interactive_mode ()) beep ();
265     else {
266       command interactive_cmd=
267 	tm_new<interactive_command_rep> (this, concrete_window (), fun, p);
268       interactive_cmd ();
269     }
270   }
271 }
272 
273