Mercurial > hg > xemacs-beta
annotate src/minibuf.c @ 5090:0ca81354c4c7
Further frame-geometry cleanups
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-03 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Intro to Window and Frame Geometry):
* internals/internals.texi (The Paned Area):
* internals/internals.texi (The Displayable Area):
Update to make note of e.g. the fact that the bottom gutter is
actually above the minibuffer.
src/ChangeLog addition:
2010-03-03 Ben Wing <ben@xemacs.org>
* emacs.c:
* emacs.c (assert_equal_failed):
* lisp.h:
* lisp.h (assert_equal):
New fun assert_equal, asserting that two values == each other, and
printing out both values upon failure.
* frame-gtk.c (gtk_initialize_frame_size):
* frame-impl.h:
* frame-impl.h (FRAME_TOP_INTERNAL_BORDER_START):
* frame-impl.h (FRAME_BOTTOM_INTERNAL_BORDER_START):
* frame-impl.h (FRAME_LEFT_INTERNAL_BORDER_START):
* frame-impl.h (FRAME_PANED_TOP_EDGE):
* frame-impl.h (FRAME_NONPANED_SIZE):
* frame-x.c (x_initialize_frame_size):
* frame.c:
* gutter.c (get_gutter_coords):
* gutter.c (calculate_gutter_size):
* gutter.h:
* gutter.h (WINDOW_REAL_TOP_GUTTER_BOUNDS):
* gutter.h (FRAME_TOP_GUTTER_BOUNDS):
* input-method-xlib.c:
* input-method-xlib.c (XIM_SetGeometry):
* redisplay-output.c (clear_left_border):
* redisplay-output.c (clear_right_border):
* redisplay-output.c (redisplay_output_pixmap):
* redisplay-output.c (redisplay_clear_region):
* redisplay-output.c (redisplay_clear_top_of_window):
* redisplay-output.c (redisplay_clear_to_window_end):
* redisplay-xlike-inc.c (XLIKE_clear_frame):
* redisplay.c:
* redisplay.c (UPDATE_CACHE_RETURN):
* redisplay.c (pixel_to_glyph_translation):
* toolbar.c (update_frame_toolbars_geometry):
* window.c (Fwindow_pixel_edges):
Get rid of some redundant macros. Consistently use the
FRAME_TOP_*_START, FRAME_RIGHT_*_END, etc. format. Rename
FRAME_*_BORDER_* to FRAME_*_INTERNAL_BORDER_*. Comment out
FRAME_BOTTOM_* for gutters and the paned area due to the
uncertainty over where the paned area actually begins. (Eventually
we should probably move the gutters outside the minibuffer so that
the paned area is contiguous.) Use FRAME_PANED_* more often in the
code to make things clearer.
Update the diagram to show that the bottom gutter is inside the
minibuffer (!) and that there are "junk boxes" when you have left
and/or right gutters (dead boxes that are mistakenly left uncleared,
unlike the corresponding scrollbar dead boxes). Update the text
appropriately to cover the bottom gutter position, etc.
Rewrite gutter-geometry code to use the FRAME_*_GUTTER_* in place of
equivalent expressions referencing other frame elements, to make the
code more portable in case we move around the gutter location.
Cleanup FRAME_*_GUTTER_BOUNDS() in gutter.h.
Add some #### GEOM! comments where I think code is incorrect --
typically, it wasn't fixed up properly when the gutter was added.
Some cosmetic changes.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 03 Mar 2010 05:07:47 -0600 |
| parents | e813cf16c015 |
| children | 99f8ebc082d9 |
| rev | line source |
|---|---|
| 428 | 1 /* Minibuffer input and completion. |
| 2 Copyright (C) 1985, 1986, 1992-1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 793 | 4 Copyright (C) 2002 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Mule 2.0, FSF 19.28. Mule-ized except as noted. | |
| 24 Substantially different from FSF. */ | |
| 25 | |
| 26 /* #### dmoore - All sorts of things in here can call lisp, like message. | |
| 27 Track all this stuff. */ | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 32 #include "buffer.h" | |
| 33 #include "commands.h" | |
| 34 #include "console-stream.h" | |
| 35 #include "events.h" | |
| 872 | 36 #include "frame-impl.h" |
| 428 | 37 #include "insdel.h" |
| 38 #include "redisplay.h" | |
| 872 | 39 #include "window-impl.h" |
| 428 | 40 |
| 41 /* Depth in minibuffer invocations. */ | |
| 42 int minibuf_level; | |
| 43 | |
| 44 Lisp_Object Qcompletion_ignore_case; | |
| 45 | |
| 46 /* Nonzero means completion ignores case. */ | |
| 47 int completion_ignore_case; | |
| 48 | |
| 49 /* List of regexps that should restrict possible completions. */ | |
| 50 Lisp_Object Vcompletion_regexp_list; | |
| 51 | |
| 52 /* The echo area buffer. */ | |
| 53 Lisp_Object Vecho_area_buffer; | |
| 54 | |
| 55 /* Prompt to display in front of the minibuffer contents */ | |
| 56 Lisp_Object Vminibuf_prompt; | |
| 57 | |
| 58 /* Added on 97/3/14 by Jareth Hein (jhod@po.iijnet.or.jp) for input system support */ | |
| 59 /* String to be displayed in front of prompt of the minibuffer contents */ | |
| 60 Lisp_Object Vminibuf_preprompt; | |
| 61 | |
| 62 /* Hook to run just after entry to minibuffer. */ | |
| 63 Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook; | |
| 64 | |
| 65 Lisp_Object Qappend_message, Qcurrent_message_label, | |
| 66 Qclear_message, Qdisplay_message; | |
| 67 | |
| 68 | |
| 69 DEFUN ("minibuffer-depth", Fminibuffer_depth, 0, 0, 0, /* | |
| 70 Return current depth of activations of minibuffer, a nonnegative integer. | |
| 71 */ | |
| 72 ()) | |
| 73 { | |
| 74 return make_int (minibuf_level); | |
| 75 } | |
| 76 | |
| 77 /* The default buffer to use as the window-buffer of minibuffer windows */ | |
| 78 /* Note there is special code in kill-buffer to make this unkillable */ | |
| 79 Lisp_Object Vminibuffer_zero; | |
| 80 | |
| 81 | |
| 82 /* Actual minibuffer invocation. */ | |
| 83 | |
| 84 static Lisp_Object | |
| 85 read_minibuffer_internal_unwind (Lisp_Object unwind_data) | |
| 86 { | |
| 87 Lisp_Object frame; | |
| 88 XWINDOW (minibuf_window)->last_modified[CURRENT_DISP] = Qzero; | |
| 89 XWINDOW (minibuf_window)->last_modified[DESIRED_DISP] = Qzero; | |
| 90 XWINDOW (minibuf_window)->last_modified[CMOTION_DISP] = Qzero; | |
| 91 XWINDOW (minibuf_window)->last_facechange[CURRENT_DISP] = Qzero; | |
| 92 XWINDOW (minibuf_window)->last_facechange[DESIRED_DISP] = Qzero; | |
| 93 XWINDOW (minibuf_window)->last_facechange[CMOTION_DISP] = Qzero; | |
| 94 Vminibuf_prompt = Felt (unwind_data, Qzero); | |
| 95 minibuf_level = XINT (Felt (unwind_data, make_int (1))); | |
| 96 while (CONSP (unwind_data)) | |
| 97 { | |
| 98 Lisp_Object victim = unwind_data; | |
| 99 unwind_data = XCDR (unwind_data); | |
| 853 | 100 free_cons (victim); |
| 428 | 101 } |
| 102 | |
| 103 /* If cursor is on the minibuffer line, | |
| 104 show the user we have exited by putting it in column 0. */ | |
| 105 frame = Fselected_frame (Qnil); | |
| 106 if (!noninteractive | |
| 107 && !NILP (frame) | |
| 108 && !NILP (XFRAME (frame)->minibuffer_window)) | |
| 109 { | |
| 110 struct window *w = XWINDOW (XFRAME (frame)->minibuffer_window); | |
| 111 redisplay_move_cursor (w, 0, 0); | |
| 112 } | |
| 113 | |
| 114 return Qnil; | |
| 115 } | |
| 116 | |
| 117 /* 97/4/13 jhod: Added for input methods */ | |
| 118 DEFUN ("set-minibuffer-preprompt", Fset_minibuffer_preprompt, 1, 1, 0, /* | |
| 119 Set the minibuffer preprompt string to PREPROMPT. This is used by language | |
| 120 input methods to relay state information to the user. | |
| 121 */ | |
| 122 (preprompt)) | |
| 123 { | |
| 124 if (NILP (preprompt)) | |
| 125 { | |
| 126 Vminibuf_preprompt = Qnil; | |
| 127 } | |
| 128 else | |
| 129 { | |
| 130 CHECK_STRING (preprompt); | |
| 131 | |
| 132 Vminibuf_preprompt = LISP_GETTEXT (preprompt); | |
| 133 } | |
| 134 return Qnil; | |
| 135 } | |
| 136 | |
| 2268 | 137 DEFUN_NORETURN ("read-minibuffer-internal", Fread_minibuffer_internal, |
| 138 1, 1, 0, /* | |
| 428 | 139 Lowest-level interface to minibuffers. Don't call this. |
| 140 */ | |
| 141 (prompt)) | |
| 142 { | |
| 143 /* This function can GC */ | |
| 2268 | 144 |
| 145 /* We used to record the specpdl_depth here, but since call_command_loop | |
| 146 never returns, we can never call unbind_to_1. Since we exit via a throw, | |
| 147 we let whoever catches unbind for us. */ | |
| 148 | |
| 428 | 149 CHECK_STRING (prompt); |
| 150 | |
| 151 single_console_state (); | |
| 152 | |
| 153 record_unwind_protect (read_minibuffer_internal_unwind, | |
| 154 noseeum_cons | |
| 155 (Vminibuf_prompt, | |
| 156 noseeum_cons (make_int (minibuf_level), Qnil))); | |
| 157 Vminibuf_prompt = LISP_GETTEXT (prompt); | |
| 158 | |
| 159 /* NOTE: Here (or somewhere around here), in FSFmacs 19.30, | |
| 160 choose_minibuf_frame() is called. This is the only | |
| 161 place in FSFmacs that it's called any more -- there's | |
| 162 also a call in xterm.c, but commented out, and 19.28 | |
| 163 had the calls in different places. | |
| 164 | |
| 165 choose_minibuf_frame() does the following: | |
| 166 | |
| 167 if (!EQ (minibuf_window, selected_frame()->minibuffer_window)) | |
| 168 { | |
| 169 Fset_window_buffer (selected_frame()->minibuffer_window, | |
| 170 XWINDOW (minibuf_window)->buffer); | |
| 171 minibuf_window = selected_frame()->minibuffer_window; | |
| 172 } | |
| 173 | |
| 174 #### Note that we don't do the set-window-buffer. This call is | |
| 175 similar, but not identical, to a set-window-buffer call made | |
| 176 in `read-from-minibuffer' in minibuf.el. I hope it's close | |
| 177 enough, because minibuf_window isn't really exported to Lisp. | |
| 178 | |
| 179 The comment above choose_minibuf_frame() reads: | |
| 180 | |
| 181 Put minibuf on currently selected frame's minibuffer. | |
| 182 We do this whenever the user starts a new minibuffer | |
| 183 or when a minibuffer exits. */ | |
| 184 | |
| 185 minibuf_window = FRAME_MINIBUF_WINDOW (selected_frame ()); | |
| 186 | |
| 187 run_hook (Qminibuffer_setup_hook); | |
| 188 | |
| 189 minibuf_level++; | |
| 190 clear_echo_area (selected_frame (), Qnil, 0); | |
| 191 | |
| 2286 | 192 call_command_loop (Qt); |
| 428 | 193 |
| 2286 | 194 RETURN_NOT_REACHED (Qnil); |
| 428 | 195 } |
| 196 | |
| 197 | |
| 198 | |
| 199 /* Completion hair */ | |
| 200 | |
| 201 /* Compare exactly LEN chars of strings at S1 and S2, | |
| 202 ignoring case if appropriate. | |
| 203 Return -1 if strings match, | |
| 204 else number of chars that match at the beginning. */ | |
| 205 | |
| 206 /* Note that this function works in Charcounts, unlike most functions. | |
| 207 This is necessary for many reasons, one of which is that two | |
| 208 strings may match even if they have different numbers of bytes, | |
| 209 if IGNORE_CASE is true. */ | |
| 210 | |
| 211 Charcount | |
| 867 | 212 scmp_1 (const Ibyte *s1, const Ibyte *s2, Charcount len, |
| 428 | 213 int ignore_case) |
| 214 { | |
| 215 Charcount l = len; | |
| 216 | |
| 217 if (ignore_case) | |
| 218 { | |
| 219 while (l) | |
| 220 { | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4704
diff
changeset
|
221 Ichar c1 = CANONCASE (0, itext_ichar (s1)); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4704
diff
changeset
|
222 Ichar c2 = CANONCASE (0, itext_ichar (s2)); |
| 428 | 223 |
| 224 if (c1 == c2) | |
| 225 { | |
| 226 l--; | |
| 867 | 227 INC_IBYTEPTR (s1); |
| 228 INC_IBYTEPTR (s2); | |
| 428 | 229 } |
| 230 else | |
| 231 break; | |
| 232 } | |
| 233 } | |
| 234 else | |
| 235 { | |
| 867 | 236 while (l && itext_ichar (s1) == itext_ichar (s2)) |
| 428 | 237 { |
| 238 l--; | |
| 867 | 239 INC_IBYTEPTR (s1); |
| 240 INC_IBYTEPTR (s2); | |
| 428 | 241 } |
| 242 } | |
| 243 | |
| 244 if (l == 0) | |
| 245 return -1; | |
| 246 else return len - l; | |
| 247 } | |
| 248 | |
| 249 | |
| 250 int | |
| 867 | 251 regexp_ignore_completion_p (const Ibyte *nonreloc, |
| 428 | 252 Lisp_Object reloc, Bytecount offset, |
| 253 Bytecount length) | |
| 254 { | |
| 255 /* Ignore this element if it fails to match all the regexps. */ | |
| 256 if (!NILP (Vcompletion_regexp_list)) | |
| 257 { | |
| 2367 | 258 EXTERNAL_LIST_LOOP_2 (re, Vcompletion_regexp_list) |
| 428 | 259 { |
| 260 CHECK_STRING (re); | |
| 261 if (fast_string_match (re, nonreloc, reloc, offset, | |
| 262 length, 0, ERROR_ME, 0) < 0) | |
| 263 return 1; | |
| 264 } | |
| 265 } | |
| 266 return 0; | |
| 267 } | |
| 268 | |
| 269 | |
| 270 /* Callers should GCPRO, since this may call eval */ | |
| 271 static int | |
| 272 ignore_completion_p (Lisp_Object completion_string, | |
| 273 Lisp_Object pred, Lisp_Object completion) | |
| 274 { | |
| 275 if (regexp_ignore_completion_p (0, completion_string, 0, -1)) | |
| 276 return 1; | |
| 277 | |
| 278 /* Ignore this element if there is a predicate | |
| 279 and the predicate doesn't like it. */ | |
| 280 if (!NILP (pred)) | |
| 281 { | |
| 282 Lisp_Object tem; | |
| 283 if (EQ (pred, Qcommandp)) | |
| 284 tem = Fcommandp (completion); | |
| 285 else | |
| 286 tem = call1 (pred, completion); | |
| 287 if (NILP (tem)) | |
| 288 return 1; | |
| 289 } | |
| 290 return 0; | |
| 291 } | |
| 292 | |
| 293 | |
| 444 | 294 /* #### Maybe we should allow COLLECTION to be a hash table. |
| 295 It is wrong for the use of obarrays to be better-rewarded than the | |
| 296 use of hash tables. By better-rewarded I mean that you can pass an | |
| 297 obarray to all of the completion functions, whereas you can't do | |
| 298 anything like that with a hash table. | |
| 428 | 299 |
| 300 To do so, there should probably be a | |
| 301 map_obarray_or_alist_or_hash_table function which would be used by | |
| 826 | 302 both Ftry_completion and Fall_completions. [[ But would the |
| 303 additional funcalls slow things down? ]] Seriously doubtful. --ben */ | |
| 428 | 304 |
| 305 DEFUN ("try-completion", Ftry_completion, 2, 3, 0, /* | |
| 444 | 306 Return common substring of all completions of STRING in COLLECTION. |
| 307 COLLECTION must be an alist, an obarray, or a function. | |
| 308 Each string in COLLECTION is tested to see if it begins with STRING. | |
| 428 | 309 All that match are compared together; the longest initial sequence |
| 444 | 310 common to all matches is returned as a string. If there is no match |
| 311 at all, nil is returned. For an exact match, t is returned. | |
| 428 | 312 |
|
4704
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
313 If COLLECTION is list, the elements of the list that are not cons |
|
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
314 cells and the cars of the elements of the list that are cons cells |
|
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
315 (which must be strings) form the set of possible completions. |
| 428 | 316 |
| 444 | 317 If COLLECTION is an obarray, the names of all symbols in the obarray |
| 318 are the possible completions. | |
| 319 | |
| 320 If COLLECTION is a function, it is called with three arguments: the | |
| 321 values STRING, PREDICATE and nil. Whatever it returns becomes the | |
| 322 value of `try-completion'. | |
| 428 | 323 |
| 444 | 324 If optional third argument PREDICATE is non-nil, it is used to test |
| 325 each possible match. The match is a candidate only if PREDICATE | |
| 326 returns non-nil. The argument given to PREDICATE is the alist element | |
| 327 or the symbol from the obarray. | |
| 428 | 328 */ |
| 444 | 329 (string, collection, predicate)) |
| 428 | 330 { |
| 331 /* This function can GC */ | |
| 332 Lisp_Object bestmatch, tail; | |
| 333 Charcount bestmatchsize = 0; | |
| 334 int list; | |
| 335 int indice = 0; | |
| 336 int matchcount = 0; | |
| 337 int obsize; | |
| 338 Lisp_Object bucket; | |
| 339 Charcount slength, blength; | |
| 340 | |
| 341 CHECK_STRING (string); | |
| 342 | |
| 444 | 343 if (CONSP (collection)) |
| 428 | 344 { |
| 444 | 345 Lisp_Object tem = XCAR (collection); |
| 428 | 346 if (SYMBOLP (tem)) /* lambda, autoload, etc. Emacs-lisp sucks */ |
| 444 | 347 return call3 (collection, string, predicate, Qnil); |
| 428 | 348 else |
| 349 list = 1; | |
| 350 } | |
| 444 | 351 else if (VECTORP (collection)) |
| 428 | 352 list = 0; |
| 444 | 353 else if (NILP (collection)) |
| 428 | 354 list = 1; |
| 355 else | |
| 444 | 356 return call3 (collection, string, predicate, Qnil); |
| 428 | 357 |
| 358 bestmatch = Qnil; | |
| 359 blength = 0; | |
| 826 | 360 slength = string_char_length (string); |
| 428 | 361 |
| 444 | 362 /* If COLLECTION is not a list, set TAIL just for gc pro. */ |
| 363 tail = collection; | |
| 428 | 364 if (!list) |
| 365 { | |
| 444 | 366 obsize = XVECTOR_LENGTH (collection); |
| 367 bucket = XVECTOR_DATA (collection)[indice]; | |
| 428 | 368 } |
| 369 else /* warning suppression */ | |
| 370 { | |
| 371 obsize = 0; | |
| 372 bucket = Qnil; | |
| 373 } | |
| 374 | |
| 375 while (1) | |
| 376 { | |
| 377 /* Get the next element of the alist or obarray. */ | |
| 378 /* Exit the loop if the elements are all used up. */ | |
| 379 /* elt gets the alist element or symbol. | |
| 380 eltstring gets the name to check as a completion. */ | |
| 381 Lisp_Object elt; | |
| 382 Lisp_Object eltstring; | |
| 383 | |
| 384 if (list) | |
| 385 { | |
| 386 if (NILP (tail)) | |
| 387 break; | |
| 388 elt = Fcar (tail); | |
|
4704
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
389 if (CONSP (elt)) |
|
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
390 eltstring = Fcar (elt); |
|
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
391 else |
|
44c9d1005ce2
Bring `try-completion''s interface closer to GNU Emacs.
Mike Sperber <sperber@deinprogramm.de>
parents:
2367
diff
changeset
|
392 eltstring = elt; |
| 428 | 393 tail = Fcdr (tail); |
| 394 } | |
| 395 else | |
| 396 { | |
| 397 if (!ZEROP (bucket)) | |
| 398 { | |
| 440 | 399 Lisp_Symbol *next; |
| 428 | 400 if (!SYMBOLP (bucket)) |
| 401 { | |
| 563 | 402 invalid_argument ("Bad obarray passed to try-completions", |
| 403 bucket); | |
| 428 | 404 } |
| 405 next = symbol_next (XSYMBOL (bucket)); | |
| 406 elt = bucket; | |
| 407 eltstring = Fsymbol_name (elt); | |
| 408 if (next) | |
| 793 | 409 bucket = wrap_symbol (next); |
| 428 | 410 else |
| 411 bucket = Qzero; | |
| 412 } | |
| 413 else if (++indice >= obsize) | |
| 414 break; | |
| 415 else | |
| 416 { | |
| 444 | 417 bucket = XVECTOR_DATA (collection)[indice]; |
| 428 | 418 continue; |
| 419 } | |
| 420 } | |
| 421 | |
| 422 /* Is this element a possible completion? */ | |
| 423 | |
| 424 if (STRINGP (eltstring)) | |
| 425 { | |
| 826 | 426 Charcount eltlength = string_char_length (eltstring); |
| 428 | 427 if (slength <= eltlength |
| 428 && (0 > scmp (XSTRING_DATA (eltstring), | |
| 429 XSTRING_DATA (string), | |
| 430 slength))) | |
| 431 { | |
| 432 { | |
| 433 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 434 int loser; | |
| 435 GCPRO4 (tail, string, eltstring, bestmatch); | |
| 444 | 436 loser = ignore_completion_p (eltstring, predicate, elt); |
| 428 | 437 UNGCPRO; |
| 438 if (loser) /* reject this one */ | |
| 439 continue; | |
| 440 } | |
| 441 | |
| 442 /* Update computation of how much all possible | |
| 443 completions match */ | |
| 444 | |
| 445 matchcount++; | |
| 446 if (NILP (bestmatch)) | |
| 447 { | |
| 448 bestmatch = eltstring; | |
| 449 blength = eltlength; | |
| 450 bestmatchsize = eltlength; | |
| 451 } | |
| 452 else | |
| 453 { | |
| 454 Charcount compare = min (bestmatchsize, eltlength); | |
| 455 Charcount matchsize = | |
| 456 scmp (XSTRING_DATA (bestmatch), | |
| 457 XSTRING_DATA (eltstring), | |
| 458 compare); | |
| 459 if (matchsize < 0) | |
| 460 matchsize = compare; | |
| 461 if (completion_ignore_case) | |
| 462 { | |
| 463 /* If this is an exact match except for case, | |
| 464 use it as the best match rather than one that is not | |
| 465 an exact match. This way, we get the case pattern | |
| 466 of the actual match. */ | |
| 467 if ((matchsize == eltlength | |
| 468 && matchsize < blength) | |
| 469 || | |
| 470 /* If there is more than one exact match ignoring | |
| 471 case, and one of them is exact including case, | |
| 472 prefer that one. */ | |
| 473 /* If there is no exact match ignoring case, | |
| 474 prefer a match that does not change the case | |
| 475 of the input. */ | |
| 476 ((matchsize == eltlength) | |
| 477 == | |
| 478 (matchsize == blength) | |
| 479 && 0 > scmp_1 (XSTRING_DATA (eltstring), | |
| 480 XSTRING_DATA (string), | |
| 481 slength, 0) | |
| 482 && 0 <= scmp_1 (XSTRING_DATA (bestmatch), | |
| 483 XSTRING_DATA (string), | |
| 484 slength, 0))) | |
| 485 { | |
| 486 bestmatch = eltstring; | |
| 487 blength = eltlength; | |
| 488 } | |
| 489 } | |
| 490 bestmatchsize = matchsize; | |
| 491 } | |
| 492 } | |
| 493 } | |
| 494 } | |
| 495 | |
| 496 if (NILP (bestmatch)) | |
| 497 return Qnil; /* No completions found */ | |
| 498 /* If we are ignoring case, and there is no exact match, | |
| 499 and no additional text was supplied, | |
| 500 don't change the case of what the user typed. */ | |
| 501 if (completion_ignore_case | |
| 502 && bestmatchsize == slength | |
| 503 && blength > bestmatchsize) | |
| 504 return string; | |
| 505 | |
| 506 /* Return t if the supplied string is an exact match (counting case); | |
| 507 it does not require any change to be made. */ | |
| 508 if (matchcount == 1 | |
| 509 && bestmatchsize == slength | |
| 510 && 0 > scmp_1 (XSTRING_DATA (bestmatch), | |
| 511 XSTRING_DATA (string), | |
| 512 bestmatchsize, 0)) | |
| 513 return Qt; | |
| 514 | |
| 515 /* Else extract the part in which all completions agree */ | |
| 516 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); | |
| 517 } | |
| 518 | |
| 519 | |
| 520 DEFUN ("all-completions", Fall_completions, 2, 3, 0, /* | |
| 444 | 521 Search for partial matches to STRING in COLLECTION. |
| 522 COLLECTION must be an alist, an obarray, or a function. | |
| 523 Each string in COLLECTION is tested to see if it begins with STRING. | |
| 524 The value is a list of all the strings from COLLECTION that match. | |
| 525 | |
| 526 If COLLECTION is an alist, the cars of the elements of the alist | |
| 527 \(which must be strings) form the set of possible completions. | |
| 528 | |
| 529 If COLLECTION is an obarray, the names of all symbols in the obarray | |
| 530 are the possible completions. | |
| 428 | 531 |
| 444 | 532 If COLLECTION is a function, it is called with three arguments: the |
| 533 values STRING, PREDICATE and t. Whatever it returns becomes the | |
| 534 value of `all-completions'. | |
| 428 | 535 |
| 444 | 536 If optional third argument PREDICATE is non-nil, it is used to test |
| 537 each possible match. The match is a candidate only if PREDICATE | |
| 538 returns non-nil. The argument given to PREDICATE is the alist element | |
| 539 or the symbol from the obarray. | |
| 428 | 540 */ |
| 444 | 541 (string, collection, predicate)) |
| 428 | 542 { |
| 543 /* This function can GC */ | |
| 544 Lisp_Object tail; | |
| 545 Lisp_Object allmatches; | |
| 546 int list; | |
| 547 int indice = 0; | |
| 548 int obsize; | |
| 549 Lisp_Object bucket; | |
| 550 Charcount slength; | |
| 551 | |
| 552 CHECK_STRING (string); | |
| 553 | |
| 444 | 554 if (CONSP (collection)) |
| 428 | 555 { |
| 444 | 556 Lisp_Object tem = XCAR (collection); |
| 428 | 557 if (SYMBOLP (tem)) /* lambda, autoload, etc. Emacs-lisp sucks */ |
| 444 | 558 return call3 (collection, string, predicate, Qt); |
| 428 | 559 else |
| 560 list = 1; | |
| 561 } | |
| 444 | 562 else if (VECTORP (collection)) |
| 428 | 563 list = 0; |
| 444 | 564 else if (NILP (collection)) |
| 428 | 565 list = 1; |
| 566 else | |
| 444 | 567 return call3 (collection, string, predicate, Qt); |
| 428 | 568 |
| 569 allmatches = Qnil; | |
| 826 | 570 slength = string_char_length (string); |
| 428 | 571 |
| 444 | 572 /* If COLLECTION is not a list, set TAIL just for gc pro. */ |
| 573 tail = collection; | |
| 428 | 574 if (!list) |
| 575 { | |
| 444 | 576 obsize = XVECTOR_LENGTH (collection); |
| 577 bucket = XVECTOR_DATA (collection)[indice]; | |
| 428 | 578 } |
| 579 else /* warning suppression */ | |
| 580 { | |
| 581 obsize = 0; | |
| 582 bucket = Qnil; | |
| 583 } | |
| 584 | |
| 585 while (1) | |
| 586 { | |
| 587 /* Get the next element of the alist or obarray. */ | |
| 588 /* Exit the loop if the elements are all used up. */ | |
| 589 /* elt gets the alist element or symbol. | |
| 590 eltstring gets the name to check as a completion. */ | |
| 591 Lisp_Object elt; | |
| 592 Lisp_Object eltstring; | |
| 593 | |
| 594 if (list) | |
| 595 { | |
| 596 if (NILP (tail)) | |
| 597 break; | |
| 598 elt = Fcar (tail); | |
| 599 eltstring = Fcar (elt); | |
| 600 tail = Fcdr (tail); | |
| 601 } | |
| 602 else | |
| 603 { | |
| 604 if (!ZEROP (bucket)) | |
| 605 { | |
| 440 | 606 Lisp_Symbol *next = symbol_next (XSYMBOL (bucket)); |
| 428 | 607 elt = bucket; |
| 608 eltstring = Fsymbol_name (elt); | |
| 609 if (next) | |
| 793 | 610 bucket = wrap_symbol (next); |
| 428 | 611 else |
| 612 bucket = Qzero; | |
| 613 } | |
| 614 else if (++indice >= obsize) | |
| 615 break; | |
| 616 else | |
| 617 { | |
| 444 | 618 bucket = XVECTOR_DATA (collection)[indice]; |
| 428 | 619 continue; |
| 620 } | |
| 621 } | |
| 622 | |
| 623 /* Is this element a possible completion? */ | |
| 624 | |
| 625 if (STRINGP (eltstring) | |
| 826 | 626 && (slength <= string_char_length (eltstring)) |
| 448 | 627 /* Reject alternatives that start with space |
| 628 unless the input starts with space. */ | |
| 826 | 629 && ((string_char_length (string) > 0 && |
| 867 | 630 string_ichar (string, 0) == ' ') |
| 631 || string_ichar (eltstring, 0) != ' ') | |
| 448 | 632 && (0 > scmp (XSTRING_DATA (eltstring), |
| 428 | 633 XSTRING_DATA (string), |
| 634 slength))) | |
| 635 { | |
| 636 /* Yes. Now check whether predicate likes it. */ | |
| 637 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 638 int loser; | |
| 639 GCPRO4 (tail, eltstring, allmatches, string); | |
| 444 | 640 loser = ignore_completion_p (eltstring, predicate, elt); |
| 428 | 641 UNGCPRO; |
| 642 if (!loser) | |
| 643 /* Ok => put it on the list. */ | |
| 644 allmatches = Fcons (eltstring, allmatches); | |
| 645 } | |
| 646 } | |
| 647 | |
| 648 return Fnreverse (allmatches); | |
| 649 } | |
| 650 | |
| 651 /* Useless FSFmacs functions */ | |
| 652 /* More than useless. I've nuked minibuf_prompt_width so they won't | |
| 653 function at all in XEmacs at the moment. They are used to | |
| 654 implement some braindamage in FSF which we aren't including. --cet */ | |
| 655 | |
| 656 #if 0 | |
| 826 | 657 DEFUN ("minibuffer-prompt", Fminibuffer_prompt, 0, 0, 0, /* |
| 428 | 658 Return the prompt string of the currently-active minibuffer. |
| 659 If no minibuffer is active, return nil. | |
| 660 */ | |
| 661 ()) | |
| 662 { | |
| 663 return Fcopy_sequence (Vminibuf_prompt); | |
| 664 } | |
| 665 | |
| 826 | 666 DEFUN ("minibuffer-prompt-width", Fminibuffer_prompt_width, 0, 0, 0, /* |
| 428 | 667 Return the display width of the minibuffer prompt. |
| 668 */ | |
| 669 ()) | |
| 670 { | |
| 671 return make_int (minibuf_prompt_width); | |
| 672 } | |
| 673 #endif /* 0 */ | |
| 674 | |
| 675 | |
| 676 /************************************************************************/ | |
| 677 /* echo area */ | |
| 678 /************************************************************************/ | |
| 679 | |
| 680 extern int stdout_needs_newline; | |
| 681 | |
| 682 static Lisp_Object | |
| 683 clear_echo_area_internal (struct frame *f, Lisp_Object label, int from_print, | |
| 684 int no_restore) | |
| 685 { | |
| 686 /* This function can call lisp */ | |
| 687 if (!NILP (Ffboundp (Qclear_message))) | |
| 688 { | |
| 793 | 689 Lisp_Object frame = wrap_frame (f); |
| 428 | 690 |
| 691 return call4 (Qclear_message, label, frame, from_print ? Qt : Qnil, | |
| 692 no_restore ? Qt : Qnil); | |
| 693 } | |
| 694 else | |
| 695 { | |
| 771 | 696 stderr_out ("\n"); |
| 428 | 697 return Qnil; |
| 698 } | |
| 699 } | |
| 700 | |
| 701 Lisp_Object | |
| 702 clear_echo_area (struct frame *f, Lisp_Object label, int no_restore) | |
| 703 { | |
| 704 /* This function can call lisp */ | |
| 705 return clear_echo_area_internal (f, label, 0, no_restore); | |
| 706 } | |
| 707 | |
| 708 Lisp_Object | |
| 709 clear_echo_area_from_print (struct frame *f, Lisp_Object label, int no_restore) | |
| 710 { | |
| 711 /* This function can call lisp */ | |
| 712 return clear_echo_area_internal (f, label, 1, no_restore); | |
| 713 } | |
| 714 | |
| 715 void | |
| 867 | 716 echo_area_append (struct frame *f, const Ibyte *nonreloc, Lisp_Object reloc, |
| 428 | 717 Bytecount offset, Bytecount length, |
| 718 Lisp_Object label) | |
| 719 { | |
| 720 /* This function can call lisp */ | |
| 721 Lisp_Object obj; | |
| 722 struct gcpro gcpro1; | |
| 723 Lisp_Object frame; | |
| 724 | |
| 440 | 725 /* There is an inlining bug in egcs-20000131 c++ that can be worked |
| 726 around as follows: */ | |
| 727 #if defined (__GNUC__) && defined (__cplusplus) | |
| 728 alloca (4); | |
| 729 #endif | |
| 730 | |
| 428 | 731 /* some callers pass in a null string as a way of clearing the echo area. |
| 732 check for length == 0 now; if this case, neither nonreloc nor reloc | |
| 733 may be valid. */ | |
| 734 if (length == 0) | |
| 735 return; | |
| 736 | |
| 737 fixup_internal_substring (nonreloc, reloc, offset, &length); | |
| 738 | |
| 739 /* also check it here, in case the string was really blank. */ | |
| 740 if (length == 0) | |
| 741 return; | |
| 742 | |
| 743 if (!NILP (Ffboundp (Qappend_message))) | |
| 744 { | |
| 745 if (STRINGP (reloc) && offset == 0 && length == XSTRING_LENGTH (reloc)) | |
| 746 obj = reloc; | |
| 747 else | |
| 748 { | |
| 749 if (STRINGP (reloc)) | |
| 750 nonreloc = XSTRING_DATA (reloc); | |
| 751 obj = make_string (nonreloc + offset, length); | |
| 752 } | |
| 753 | |
| 793 | 754 frame = wrap_frame (f); |
| 428 | 755 GCPRO1 (obj); |
| 756 call4 (Qappend_message, label, obj, frame, | |
| 757 EQ (label, Qprint) ? Qt : Qnil); | |
| 758 UNGCPRO; | |
| 759 } | |
| 760 else | |
| 761 { | |
| 762 if (STRINGP (reloc)) | |
| 763 nonreloc = XSTRING_DATA (reloc); | |
| 826 | 764 write_string_1 (Qexternal_debugging_output, nonreloc + offset, length); |
| 428 | 765 } |
| 766 } | |
| 767 | |
| 768 void | |
| 867 | 769 echo_area_message (struct frame *f, const Ibyte *nonreloc, |
| 428 | 770 Lisp_Object reloc, Bytecount offset, Bytecount length, |
| 771 Lisp_Object label) | |
| 772 { | |
| 773 /* This function can call lisp */ | |
| 774 clear_echo_area (f, label, 1); | |
| 775 echo_area_append (f, nonreloc, reloc, offset, length, label); | |
| 776 } | |
| 777 | |
| 778 int | |
| 2286 | 779 echo_area_active (struct frame *UNUSED (f)) |
| 428 | 780 { |
| 781 /* By definition, the echo area is active if the echo-area buffer | |
| 782 is not empty. No need to call Lisp code. (Anyway, this function | |
| 783 is called from redisplay.) */ | |
| 784 struct buffer *echo_buffer = XBUFFER (Vecho_area_buffer); | |
| 785 return BUF_BEGV (echo_buffer) != BUF_ZV (echo_buffer); | |
| 786 } | |
| 787 | |
| 788 Lisp_Object | |
| 789 echo_area_status (struct frame *f) | |
| 790 { | |
| 791 /* This function can call lisp */ | |
| 792 if (!NILP (Ffboundp (Qcurrent_message_label))) | |
| 793 { | |
| 793 | 794 Lisp_Object frame = wrap_frame (f); |
| 428 | 795 |
| 796 return call1 (Qcurrent_message_label, frame); | |
| 797 } | |
| 798 else | |
| 799 return stdout_needs_newline ? Qmessage : Qnil; | |
| 800 } | |
| 801 | |
| 802 Lisp_Object | |
| 2286 | 803 echo_area_contents (struct frame *UNUSED (f)) |
| 428 | 804 { |
| 805 /* See above. By definition, the contents of the echo-area buffer | |
| 806 are the contents of the echo area. */ | |
| 807 return Fbuffer_substring (Qnil, Qnil, Vecho_area_buffer); | |
| 808 } | |
| 809 | |
| 810 /* Dump an informative message to the echo area. This function takes a | |
| 811 string in internal format. */ | |
| 812 void | |
| 867 | 813 message_internal (const Ibyte *nonreloc, Lisp_Object reloc, |
| 428 | 814 Bytecount offset, Bytecount length) |
| 815 { | |
| 816 /* This function can call lisp */ | |
| 817 if (NILP (Vexecuting_macro)) | |
| 818 echo_area_message (selected_frame (), nonreloc, reloc, offset, length, | |
| 819 Qmessage); | |
| 820 } | |
| 821 | |
| 822 void | |
| 867 | 823 message_append_internal (const Ibyte *nonreloc, Lisp_Object reloc, |
| 428 | 824 Bytecount offset, Bytecount length) |
| 825 { | |
| 826 /* This function can call lisp */ | |
| 827 if (NILP (Vexecuting_macro)) | |
| 828 echo_area_append (selected_frame (), nonreloc, reloc, offset, length, | |
| 829 Qmessage); | |
| 830 } | |
| 831 | |
| 832 /* The next three functions are interfaces to message_internal() that | |
| 833 take strings in external format. message() does I18N3 translating | |
| 834 on the format string; message_no_translate() does not. */ | |
| 835 | |
| 836 static void | |
| 867 | 837 message_1 (const CIbyte *fmt, va_list args) |
| 428 | 838 { |
| 839 /* This function can call lisp */ | |
| 840 if (fmt) | |
| 841 { | |
| 842 struct gcpro gcpro1; | |
| 843 /* message_internal() might GC, e.g. if there are after-change-hooks | |
| 844 on the echo area buffer */ | |
| 771 | 845 Lisp_Object obj = emacs_vsprintf_string (fmt, args); |
| 428 | 846 GCPRO1 (obj); |
| 847 message_internal (0, obj, 0, -1); | |
| 848 UNGCPRO; | |
| 849 } | |
| 850 else | |
| 851 message_internal (0, Qnil, 0, 0); | |
| 852 } | |
| 853 | |
| 854 static void | |
| 867 | 855 message_append_1 (const CIbyte *fmt, va_list args) |
| 428 | 856 { |
| 857 /* This function can call lisp */ | |
| 858 if (fmt) | |
| 859 { | |
| 860 struct gcpro gcpro1; | |
| 861 /* message_internal() might GC, e.g. if there are after-change-hooks | |
| 862 on the echo area buffer */ | |
| 771 | 863 Lisp_Object obj = emacs_vsprintf_string (fmt, args); |
| 428 | 864 GCPRO1 (obj); |
| 865 message_append_internal (0, obj, 0, -1); | |
| 866 UNGCPRO; | |
| 867 } | |
| 868 else | |
| 869 message_append_internal (0, Qnil, 0, 0); | |
| 870 } | |
| 871 | |
| 872 void | |
| 873 clear_message (void) | |
| 874 { | |
| 875 /* This function can call lisp */ | |
| 876 message_internal (0, Qnil, 0, 0); | |
| 877 } | |
| 878 | |
| 879 void | |
| 442 | 880 message (const char *fmt, ...) |
| 428 | 881 { |
| 882 /* This function can call lisp */ | |
| 883 /* I think it's OK to pass the data of Lisp strings as arguments to | |
| 884 this function. No GC'ing will occur until the data has already | |
| 885 been copied. */ | |
| 886 va_list args; | |
| 887 | |
| 888 va_start (args, fmt); | |
| 889 if (fmt) | |
| 890 fmt = GETTEXT (fmt); | |
| 891 message_1 (fmt, args); | |
| 892 va_end (args); | |
| 893 } | |
| 894 | |
| 895 void | |
| 442 | 896 message_append (const char *fmt, ...) |
| 428 | 897 { |
| 898 /* This function can call lisp */ | |
| 899 va_list args; | |
| 900 | |
| 901 va_start (args, fmt); | |
| 902 if (fmt) | |
| 903 fmt = GETTEXT (fmt); | |
| 904 message_append_1 (fmt, args); | |
| 905 va_end (args); | |
| 906 } | |
| 907 | |
| 908 void | |
| 442 | 909 message_no_translate (const char *fmt, ...) |
| 428 | 910 { |
| 911 /* This function can call lisp */ | |
| 912 /* I think it's OK to pass the data of Lisp strings as arguments to | |
| 913 this function. No GC'ing will occur until the data has already | |
| 914 been copied. */ | |
| 915 va_list args; | |
| 916 | |
| 917 va_start (args, fmt); | |
| 918 message_1 (fmt, args); | |
| 919 va_end (args); | |
| 920 } | |
| 921 | |
| 922 | |
| 923 /************************************************************************/ | |
| 924 /* initialization */ | |
| 925 /************************************************************************/ | |
| 926 | |
| 927 void | |
| 928 syms_of_minibuf (void) | |
| 929 { | |
| 563 | 930 DEFSYMBOL (Qminibuffer_setup_hook); |
| 428 | 931 |
| 563 | 932 DEFSYMBOL (Qcompletion_ignore_case); |
| 428 | 933 |
| 934 DEFSUBR (Fminibuffer_depth); | |
| 935 #if 0 | |
| 936 DEFSUBR (Fminibuffer_prompt); | |
| 937 DEFSUBR (Fminibuffer_prompt_width); | |
| 938 #endif | |
| 939 DEFSUBR (Fset_minibuffer_preprompt); | |
| 940 DEFSUBR (Fread_minibuffer_internal); | |
| 941 | |
| 942 DEFSUBR (Ftry_completion); | |
| 943 DEFSUBR (Fall_completions); | |
| 944 | |
| 563 | 945 DEFSYMBOL (Qappend_message); |
| 946 DEFSYMBOL (Qclear_message); | |
| 947 DEFSYMBOL (Qdisplay_message); | |
| 948 DEFSYMBOL (Qcurrent_message_label); | |
| 428 | 949 } |
| 950 | |
| 951 void | |
| 952 reinit_vars_of_minibuf (void) | |
| 953 { | |
| 954 minibuf_level = 0; | |
| 955 } | |
| 956 | |
| 957 void | |
| 958 vars_of_minibuf (void) | |
| 959 { | |
| 960 staticpro (&Vminibuf_prompt); | |
| 961 Vminibuf_prompt = Qnil; | |
| 962 | |
| 963 /* Added by Jareth Hein (jhod@po.iijnet.or.jp) for input system support */ | |
| 964 staticpro (&Vminibuf_preprompt); | |
| 965 Vminibuf_preprompt = Qnil; | |
| 966 | |
| 967 DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook /* | |
| 968 Normal hook run just after entry to minibuffer. | |
| 969 */ ); | |
| 970 Vminibuffer_setup_hook = Qnil; | |
| 971 | |
| 972 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case /* | |
| 973 Non-nil means don't consider case significant in completion. | |
| 974 */ ); | |
| 975 completion_ignore_case = 0; | |
| 976 | |
| 977 DEFVAR_LISP ("completion-regexp-list", &Vcompletion_regexp_list /* | |
| 978 List of regexps that should restrict possible completions. | |
| 979 Each completion has to match all regexps in this list. | |
| 980 */ ); | |
| 981 Vcompletion_regexp_list = Qnil; | |
| 982 } | |
| 983 | |
| 984 void | |
| 985 reinit_complex_vars_of_minibuf (void) | |
| 986 { | |
| 987 /* This function can GC */ | |
| 988 #ifdef I18N3 | |
| 989 /* #### This needs to be fixed up so that the gettext() gets called | |
| 990 at runtime instead of at load time. */ | |
| 991 #endif | |
| 992 Vminibuffer_zero | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4704
diff
changeset
|
993 = Fget_buffer_create (build_ascstring (" *Minibuf-0*")); |
| 428 | 994 Vecho_area_buffer |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4704
diff
changeset
|
995 = Fget_buffer_create (build_ascstring (" *Echo Area*")); |
| 428 | 996 } |
| 997 | |
| 998 void | |
| 999 complex_vars_of_minibuf (void) | |
| 1000 { | |
| 1001 reinit_complex_vars_of_minibuf (); | |
| 1002 } |