1;;; crm.el --- read multiple strings with completion 2 3;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Sen Nagata <sen@eccosys.com> 7;; Keywords: completion, minibuffer, multiple elements 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; This code defines a function, `completing-read-multiple', which 29;; provides the ability to read multiple strings in the minibuffer, 30;; with completion. 31 32;; By using this functionality, a user may specify multiple strings at 33;; a single prompt, optionally using completion. 34 35;; Multiple strings are specified by separating each of the strings 36;; with a prespecified separator character. For example, if the 37;; separator character is a comma, the strings 'alice', 'bob', and 38;; 'eve' would be specified as 'alice,bob,eve'. 39 40;; The default value for the separator character is the value of 41;; `crm-default-separator' (comma). The separator character may be 42;; changed by modifying the value of `crm-separator'. 43 44;; Contiguous strings of non-separator-characters are referred to as 45;; 'elements'. In the aforementioned example, the elements are: 46;; 'alice', 'bob', and 'eve'. 47 48;; Completion is available on a per-element basis. For example, if 49;; the contents of the minibuffer are 'alice,bob,eve' and point is 50;; between 'l' and 'i', pressing TAB operates on the element 'alice'. 51 52;; For the moment, I have decided to not bind any special behavior to 53;; the separator key. In the future, the separator key might be used 54;; to provide completion in certain circumstances. One of the reasons 55;; why this functionality is not yet provided is that it is unclear to 56;; the author what the precise circumstances are, under which 57;; separator-invoked completion should be provided. 58 59;; Design note: `completing-read-multiple' is modeled after 60;; `completing-read'. They should be similar -- it was intentional. 61 62;; Some of this code started out as translation from C code in 63;; src/minibuf.c to Emacs Lisp code. 64 65;; Thanks to Richard Stallman for all of his help (many of the good 66;; ideas in here are from him), Gerd Moellmann for his attention, 67;; Stefan Monnier for responding with a code sample and comments very 68;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback. 69 70;;; Questions and Thoughts: 71 72;; -the author has gone through a number of test-and-fix cycles w/ 73;; this code, so it should be usable. please let me know if you find 74;; any problems. 75 76;; -should `completing-read-multiple' allow a trailing separator in 77;; a return value when REQUIRE-MATCH is t? if not, should beep when a user 78;; tries to exit the minibuffer via RET? 79 80;; -TODO: possibly make return values from `crm-do-completion' into constants 81 82;; -TODO: find out whether there is an appropriate way to distinguish between 83;; functions intended for internal use and those that aren't. 84 85;; -tip: use M-f and M-b for ease of navigation among elements. 86 87;;; History: 88;; 89;; 2000-04-10: 90;; 91;; first revamped version 92 93;;; Code: 94(defconst crm-default-separator "," 95 "Default separator for `completing-read-multiple'.") 96 97(defvar crm-separator crm-default-separator 98 "Separator used for separating strings in `completing-read-multiple'. 99It should be a single character string that doesn't appear in the list of 100completion candidates. Modify this value to make `completing-read-multiple' 101use a separator other than `crm-default-separator'.") 102 103;; actual filling in of these maps occurs below via `crm-init-keymaps' 104(defvar crm-local-completion-map nil 105 "Local keymap for minibuffer multiple input with completion. 106Analog of `minibuffer-local-completion-map'.") 107 108(defvar crm-local-must-match-map nil 109 "Local keymap for minibuffer multiple input with exact match completion. 110Analog of `minibuffer-local-must-match-map' for crm.") 111 112(defvar crm-completion-table nil 113 "An alist whose elements' cars are strings, or an obarray. 114This is a table used for completion by `completing-read-multiple' and its 115supporting functions.") 116 117;; this is supposed to be analogous to last_exact_completion in src/minibuf.c 118(defvar crm-last-exact-completion nil 119 "Completion string if last attempt reported \"Complete, but not unique\".") 120 121(defvar crm-left-of-element nil 122 "String to the left of the current element.") 123 124(defvar crm-current-element nil 125 "The current element.") 126 127(defvar crm-right-of-element nil 128 "String to the right of the current element.") 129 130(defvar crm-beginning-of-element nil 131 "Buffer position representing the beginning of the current element.") 132 133(defvar crm-end-of-element nil 134 "Buffer position representing the end of the current element.") 135 136;; emulates temp_echo_area_glyphs from src/minibuf.c 137(defun crm-temp-echo-area-glyphs (message-string) 138 "Temporarily display MESSAGE-STRING in echo area. 139After user-input or 2 seconds, erase the displayed string." 140 (save-excursion 141 (goto-char (point-max)) 142 (insert message-string) 143 (sit-for 2) 144 (backward-char (length message-string)) 145 (delete-char (length message-string)))) 146 147;; this function evolved from a posting by Stefan Monnier 148(defun crm-collection-fn (string predicate flag) 149 "Function used by `completing-read-multiple' to compute completion values. 150The value of STRING is the string to be completed. 151 152The value of PREDICATE is a function to filter possible matches, or 153nil if none. 154 155The value of FLAG is used to specify the type of completion operation. 156A value of nil specifies `try-completion'. A value of t specifies 157`all-completions'. A value of lambda specifes a test for an exact match. 158 159For more information on STRING, PREDICATE, and FLAG, see the Elisp 160Reference sections on 'Programmed Completion' and 'Basic Completion 161Functions'." 162 (let ((lead "")) 163 (when (string-match (concat ".*" crm-separator) string) 164 (setq lead (substring string 0 (match-end 0))) 165 (setq string (substring string (match-end 0)))) 166 (if (eq flag 'lambda) 167 ;; return t for exact match, nil otherwise 168 (let ((result (try-completion string crm-completion-table predicate))) 169 (if (stringp result) 170 nil 171 (if result 172 t 173 nil)))) 174 (if flag 175 ;; called via (all-completions string 'crm-completion-fn predicate)? 176 (all-completions string crm-completion-table predicate) 177 ;; called via (try-completion string 'crm-completion-fn predicate)? 178 (let ((result (try-completion string crm-completion-table predicate))) 179 (if (stringp result) 180 (concat lead result) 181 result))))) 182 183(defun crm-find-current-element () 184 "Parse the minibuffer to find the current element. 185If no element can be found, return nil. 186 187If an element is found, bind: 188 189 -the variable `crm-current-element' to the current element, 190 191 -the variables `crm-left-of-element' and `crm-right-of-element' to 192 the strings to the left and right of the current element, 193 respectively, and 194 195 -the variables `crm-beginning-of-element' and `crm-end-of-element' to 196 the buffer positions of the beginning and end of the current element 197 respectively, 198 199and return t." 200 (let* ((prompt-end (minibuffer-prompt-end)) 201 (minibuffer-string (buffer-substring prompt-end (point-max))) 202 (end-index (or (string-match "," minibuffer-string (- (point) prompt-end)) 203 (- (point-max) prompt-end))) 204 (target-string (substring minibuffer-string 0 end-index)) 205 (index (or (string-match 206 (concat crm-separator "\\([^" crm-separator "]*\\)$") 207 target-string) 208 (string-match 209 (concat "^\\([^" crm-separator "]*\\)$") 210 target-string)))) 211 (if (not (numberp index)) 212 ;; no candidate found 213 nil 214 (progn 215 ;; 216 (setq crm-beginning-of-element (match-beginning 1)) 217 (setq crm-end-of-element (+ end-index prompt-end)) 218 ;; string to the left of the current element 219 (setq crm-left-of-element 220 (substring target-string 0 (match-beginning 1))) 221 ;; the current element 222 (setq crm-current-element (match-string 1 target-string)) 223 ;; string to the right of the current element 224 (setq crm-right-of-element (substring minibuffer-string end-index)) 225 t)))) 226 227(defun crm-test-completion (candidate) 228 "Return t if CANDIDATE is an exact match for a valid completion." 229 (let ((completions 230 ;; TODO: verify whether the arguments are appropriate 231 (all-completions 232 candidate crm-completion-table minibuffer-completion-predicate))) 233 (if (member candidate completions) 234 t 235 nil))) 236 237(defun crm-minibuffer-completion-help () 238 "Display a list of possible completions of the current minibuffer element." 239 (interactive) 240 (message "Making completion list...") 241 (if (not (crm-find-current-element)) 242 nil 243 (let ((completions (all-completions crm-current-element 244 minibuffer-completion-table 245 minibuffer-completion-predicate))) 246 (message nil) 247 (if (null completions) 248 (crm-temp-echo-area-glyphs " [No completions]") 249 (with-output-to-temp-buffer "*Completions*" 250 (display-completion-list 251 (sort completions 'string-lessp) 252 crm-current-element))))) 253 nil) 254 255(defun crm-do-completion () 256 "This is the internal completion engine. 257This function updates the text in the minibuffer 258to complete the current string, and returns a number between 0 and 6. 259The meanings of the return values are: 260 261 0 - the string has no possible completion 262 1 - the string is already a valid and unique match 263 2 - not used 264 3 - the string is already a valid match (but longer matches exist too) 265 4 - the string was completed to a valid match 266 5 - some completion has been done, but the result is not a match 267 6 - no completion was done, and the string is not an exact match" 268 269 (if (not (crm-find-current-element)) 270 nil 271 (let (last completion completedp) 272 (setq completion 273 (try-completion crm-current-element 274 minibuffer-completion-table 275 minibuffer-completion-predicate)) 276 (setq last crm-last-exact-completion) 277 (setq crm-last-exact-completion nil) 278 279 (catch 'crm-exit 280 281 (if (null completion) ; no possible completion 282 (progn 283 (crm-temp-echo-area-glyphs " [No match]") 284 (throw 'crm-exit 0))) 285 286 (if (eq completion t) ; was already an exact and unique completion 287 (throw 'crm-exit 1)) 288 289 (setq completedp 290 (null (string-equal completion crm-current-element))) 291 292 (if completedp 293 (progn 294 (delete-region (minibuffer-prompt-end) (point-max)) 295 (insert crm-left-of-element completion) 296 ;; (if crm-complete-up-to-point 297 ;; (insert crm-separator)) 298 (insert crm-right-of-element) 299 (backward-char (length crm-right-of-element)) 300 ;; TODO: is this correct? 301 (setq crm-current-element completion))) 302 303 (if (null (crm-test-completion crm-current-element)) 304 (progn 305 (if completedp ; some completion happened 306 (throw 'crm-exit 5) 307 (if completion-auto-help 308 (crm-minibuffer-completion-help) 309 (crm-temp-echo-area-glyphs " [Next char not unique]"))) 310 (throw 'crm-exit 6)) 311 (if completedp 312 (throw 'crm-exit 4))) 313 314 (setq crm-last-exact-completion completion) 315 (if (not (null last)) 316 (progn 317 (if (not (null (equal crm-current-element last))) 318 (crm-minibuffer-completion-help)))) 319 320 ;; returning -- was already an exact completion 321 (throw 'crm-exit 3))))) 322 323(defun crm-minibuffer-complete () 324 "Complete the current element. 325If no characters can be completed, display a list of possible completions. 326 327Return t if the current element is now a valid match; otherwise return nil." 328 (interactive) 329 ;; take care of scrolling if necessary -- completely cribbed from minibuf.c 330 (if (not (eq last-command this-command)) 331 ;; ok? 332 (setq minibuffer-scroll-window nil)) 333 (let ((window minibuffer-scroll-window)) 334 (if (and (not (null window)) 335 ;; ok? 336 (not (null (window-buffer window)))) 337 (let (tem) 338 (set-buffer (window-buffer window)) 339 ;; ok? 340 (setq tem (pos-visible-in-window-p (point-max) window)) 341 (if (not (null tem)) 342 ;; ok? 343 (set-window-start window (point-min) nil) 344 (scroll-other-window nil)) 345 ;; reaching here means exiting the function w/ return value of nil 346 nil) 347 348 (let* ( 349 ;(crm-end-of-element nil) 350 (result (crm-do-completion))) 351 (cond 352 ((eq 0 result) 353 nil) 354 ((eq 1 result) 355 ;; adapted from Emacs 21 356 (if (not (eq (point) crm-end-of-element)) 357 (goto-char (+ 1 crm-end-of-element))) 358 (crm-temp-echo-area-glyphs " [Sole completion]") 359 t) 360 ((eq 3 result) 361 ;; adapted from Emacs 21 362 (if (not (eq (point) crm-end-of-element)) 363 (goto-char (+ 1 crm-end-of-element))) 364 (crm-temp-echo-area-glyphs " [Complete, but not unique]") 365 t)))))) 366 367;; i love traffic lights...but only when they're green 368(defun crm-find-longest-completable-substring (string) 369 "Determine the longest completable (left-anchored) substring of STRING. 370The description \"left-anchored\" means the positions of the characters 371in the substring must be the same as those of the corresponding characters 372in STRING. Anchoring is what `^' does in a regular expression. 373 374The table and predicate used for completion are 375`minibuffer-completion-table' and `minibuffer-completion-predicate', 376respectively. 377 378A non-nil return value means that there is some substring which is 379completable. A return value of t means that STRING itself is 380completable. If a string value is returned it is the longest 381completable proper substring of STRING. If nil is returned, STRING 382does not have any non-empty completable substrings. 383 384Remember: \"left-anchored\" substring" 385 (let* ((length-of-string (length string)) 386 (index length-of-string) 387 (done (if (> length-of-string 0) 388 nil 389 t)) 390 (first t) ; ugh, special handling for first time through... 391 goal-string 392 result) 393 ;; loop through left-anchored substrings in order of descending length, 394 ;; find the first substring that is completable 395 (while (not done) 396 (setq result (try-completion (substring string 0 index) 397 minibuffer-completion-table 398 minibuffer-completion-predicate)) 399 (if result 400 ;; found completable substring 401 (progn 402 (setq done t) 403 (if (and (eq result t) first) 404 ;; exactly matching string first time through 405 (setq goal-string t) 406 ;; fully-completed proper substring 407 (setq goal-string (substring string 0 index))))) 408 (setq index (1- index)) 409 (if first 410 (setq first nil)) 411 (if (<= index 0) 412 (setq done t))) 413 ;; possible values include: t, nil, some string 414 goal-string)) 415 416;; TODO: decide whether trailing separator is allowed. current 417;; implementation appears to allow it 418(defun crm-strings-completed-p (separated-string) 419 "Verify that strings in SEPARATED-STRING are completed strings. 420A return value of t means that all strings were verified. A number is 421returned if verification was unsuccessful. This number represents the 422position in SEPARATED-STRING up to where completion was successful." 423 (let ((strings (split-string separated-string crm-separator)) 424 ;; buffers start at 1, not 0 425 (current-position 1) 426 current-string 427 result 428 done) 429 (while (and strings (not done)) 430 (setq current-string (car strings) 431 result (try-completion current-string 432 minibuffer-completion-table 433 minibuffer-completion-predicate)) 434 (if (eq result t) 435 (setq strings (cdr strings) 436 current-position (+ current-position 437 (length current-string) 438 ;; automatically adding 1 for separator 439 ;; character 440 1)) 441 ;; still one more case of a match 442 (if (stringp result) 443 (let ((string-list 444 (all-completions result 445 minibuffer-completion-table 446 minibuffer-completion-predicate))) 447 (if (member result string-list) 448 ;; ho ho, code duplication... 449 (setq strings (cdr strings) 450 current-position (+ current-position 451 (length current-string) 452 1)) 453 (progn 454 (setq done t) 455 ;; current-string is a partially-completed string 456 (setq current-position (+ current-position 457 (length current-string)))))) 458 ;; current-string cannot be completed 459 (let ((completable-substring 460 (crm-find-longest-completable-substring current-string))) 461 (setq done t) 462 (setq current-position (+ current-position 463 (length completable-substring))))))) 464 ;; return our result 465 (if (null strings) 466 t 467 current-position))) 468 469;; try to complete candidate, then check all separated strings. move 470;; point to problem position if checking fails for some string. if 471;; checking succeeds for all strings, exit. 472(defun crm-minibuffer-complete-and-exit () 473 "If all of the minibuffer elements are valid completions then exit. 474All elements in the minibuffer must match. If there is a mismatch, move point 475to the location of mismatch and do not exit. 476 477This function is modeled after `minibuffer_complete_and_exit' in src/minibuf.c" 478 (interactive) 479 480 (if (not (crm-find-current-element)) 481 nil 482 (let (result) 483 484 (setq result 485 (catch 'crm-exit 486 487 (if (eq (minibuffer-prompt-end) (point-max)) 488 (throw 'crm-exit t)) 489 490 ;; TODO: this test is suspect? 491 (if (not (null (crm-test-completion crm-current-element))) 492 (throw 'crm-exit "check")) 493 494 ;; TODO: determine how to detect errors 495 (let ((result (crm-do-completion))) 496 497 (cond 498 ((or (eq 1 result) 499 (eq 3 result)) 500 (throw 'crm-exit "check")) 501 ((eq 4 result) 502 (if (not (null minibuffer-completion-confirm)) 503 (progn 504 (crm-temp-echo-area-glyphs " [Confirm]") 505 nil) 506 (throw 'crm-exit "check"))) 507 (nil))))) 508 509 (if (null result) 510 nil 511 (if (equal result "check") 512 (let ((check-strings 513 (crm-strings-completed-p 514 (buffer-substring (minibuffer-prompt-end) (point-max))))) 515 ;; check all of minibuffer 516 (if (eq check-strings t) 517 (throw 'exit nil) 518 (if (numberp check-strings) 519 (progn 520 (goto-char check-strings) 521 (crm-temp-echo-area-glyphs " [An element did not match]")) 522 (message "Unexpected error")))) 523 (if (eq result t) 524 (throw 'exit nil) 525 (message "Unexpected error"))))))) 526 527(defun crm-init-keymaps () 528 "Initialize the keymaps used by `completing-read-multiple'. 529Two keymaps are used depending on the value of the REQUIRE-MATCH 530argument of the function `completing-read-multiple'. 531 532If REQUIRE-MATCH is nil, the keymap `crm-local-completion-map' is used. 533This keymap inherits from the keymap named `minibuffer-local-completion-map'. 534The only difference is that TAB is bound to `crm-minibuffer-complete' in 535the inheriting keymap. 536 537If REQUIRE-MATCH is non-nil, the keymap `crm-local-must-match-map' is used. 538This keymap inherits from the keymap named `minibuffer-local-must-match-map'. 539The inheriting keymap binds RET to `crm-minibuffer-complete-and-exit' 540and TAB to `crm-minibuffer-complete'." 541 (unless crm-local-completion-map 542 (setq crm-local-completion-map (make-sparse-keymap)) 543 (set-keymap-parent crm-local-completion-map 544 minibuffer-local-completion-map) 545 ;; key definitions 546 (define-key crm-local-completion-map 547 (kbd "TAB") 548 (function crm-minibuffer-complete))) 549 550 (unless crm-local-must-match-map 551 (setq crm-local-must-match-map (make-sparse-keymap)) 552 (set-keymap-parent crm-local-must-match-map 553 minibuffer-local-must-match-map) 554 ;; key definitions 555 (define-key crm-local-must-match-map 556 (kbd "RET") 557 (function crm-minibuffer-complete-and-exit)) 558 (define-key crm-local-must-match-map 559 (kbd "TAB") 560 (function crm-minibuffer-complete)))) 561 562(crm-init-keymaps) 563 564;; superemulates behavior of completing_read in src/minibuf.c 565;;;###autoload 566(defun completing-read-multiple 567 (prompt table &optional predicate require-match initial-input 568 hist def inherit-input-method) 569 "Read multiple strings in the minibuffer, with completion. 570By using this functionality, a user may specify multiple strings at a 571single prompt, optionally using completion. 572 573Multiple strings are specified by separating each of the strings with 574a prespecified separator character. For example, if the separator 575character is a comma, the strings 'alice', 'bob', and 'eve' would be 576specified as 'alice,bob,eve'. 577 578The default value for the separator character is the value of 579`crm-default-separator' (comma). The separator character may be 580changed by modifying the value of `crm-separator'. 581 582Contiguous strings of non-separator-characters are referred to as 583'elements'. In the aforementioned example, the elements are: 'alice', 584'bob', and 'eve'. 585 586Completion is available on a per-element basis. For example, if the 587contents of the minibuffer are 'alice,bob,eve' and point is between 588'l' and 'i', pressing TAB operates on the element 'alice'. 589 590The return value of this function is a list of the read strings. 591 592See the documentation for `completing-read' for details on the arguments: 593PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and 594INHERIT-INPUT-METHOD." 595 (let* ((minibuffer-completion-table (function crm-collection-fn)) 596 (minibuffer-completion-predicate predicate) 597 ;; see completing_read in src/minibuf.c 598 (minibuffer-completion-confirm 599 (unless (eq require-match t) require-match)) 600 (crm-completion-table table) 601 crm-last-exact-completion 602 crm-current-element 603 crm-left-of-element 604 crm-right-of-element 605 crm-beginning-of-element 606 crm-end-of-element 607 (map (if require-match 608 crm-local-must-match-map 609 crm-local-completion-map)) 610 ;; If the user enters empty input, read-from-minibuffer returns 611 ;; the empty string, not DEF. 612 (input (read-from-minibuffer 613 prompt initial-input map 614 nil hist def inherit-input-method))) 615 (and def (string-equal input "") (setq input def)) 616 (split-string input crm-separator))) 617 618;; testing and debugging 619;; (defun crm-init-test-environ () 620;; "Set up some variables for testing." 621;; (interactive) 622;; (setq my-prompt "Prompt: ") 623;; (setq my-table 624;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma") 625;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb") 626;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb") 627;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb") 628;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb") 629;; )) 630;; (setq my-separator ",")) 631 632;(completing-read-multiple my-prompt my-table) 633;(completing-read-multiple my-prompt my-table nil t) 634;(completing-read-multiple my-prompt my-table nil "match") 635;(completing-read my-prompt my-table nil t) 636;(completing-read my-prompt my-table nil "match") 637 638(provide 'crm) 639 640;;; arch-tag: db1911d9-86c6-4a42-b32a-4910701b15a6 641;;; crm.el ends here 642