Source

ilisp / completer.el

   1
   2
   3
   4
   5
   6
   7
   8
   9
  10
  11
  12
  13
  14
  15
  16
  17
  18
  19
  20
  21
  22
  23
  24
  25
  26
  27
  28
  29
  30
  31
  32
  33
  34
  35
  36
  37
  38
  39
  40
  41
  42
  43
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75
  76
  77
  78
  79
  80
  81
  82
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 132
 133
 134
 135
 136
 137
 138
 139
 140
 141
 142
 143
 144
 145
 146
 147
 148
 149
 150
 151
 152
 153
 154
 155
 156
 157
 158
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169
 170
 171
 172
 173
 174
 175
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188
 189
 190
 191
 192
 193
 194
 195
 196
 197
 198
 199
 200
 201
 202
 203
 204
 205
 206
 207
 208
 209
 210
 211
 212
 213
 214
 215
 216
 217
 218
 219
 220
 221
 222
 223
 224
 225
 226
 227
 228
 229
 230
 231
 232
 233
 234
 235
 236
 237
 238
 239
 240
 241
 242
 243
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256
 257
 258
 259
 260
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275
 276
 277
 278
 279
 280
 281
 282
 283
 284
 285
 286
 287
 288
 289
 290
 291
 292
 293
 294
 295
 296
 297
 298
 299
 300
 301
 302
 303
 304
 305
 306
 307
 308
 309
 310
 311
 312
 313
 314
 315
 316
 317
 318
 319
 320
 321
 322
 323
 324
 325
 326
 327
 328
 329
 330
 331
 332
 333
 334
 335
 336
 337
 338
 339
 340
 341
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356
 357
 358
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375
 376
 377
 378
 379
 380
 381
 382
 383
 384
 385
 386
 387
 388
 389
 390
 391
 392
 393
 394
 395
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407
 408
 409
 410
 411
 412
 413
 414
 415
 416
 417
 418
 419
 420
 421
 422
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434
 435
 436
 437
 438
 439
 440
 441
 442
 443
 444
 445
 446
 447
 448
 449
 450
 451
 452
 453
 454
 455
 456
 457
 458
 459
 460
 461
 462
 463
 464
 465
 466
 467
 468
 469
 470
 471
 472
 473
 474
 475
 476
 477
 478
 479
 480
 481
 482
 483
 484
 485
 486
 487
 488
 489
 490
 491
 492
 493
 494
 495
 496
 497
 498
 499
 500
 501
 502
 503
 504
 505
 506
 507
 508
 509
 510
 511
 512
 513
 514
 515
 516
 517
 518
 519
 520
 521
 522
 523
 524
 525
 526
 527
 528
 529
 530
 531
 532
 533
 534
 535
 536
 537
 538
 539
 540
 541
 542
 543
 544
 545
 546
 547
 548
 549
 550
 551
 552
 553
 554
 555
 556
 557
 558
 559
 560
 561
 562
 563
 564
 565
 566
 567
 568
 569
 570
 571
 572
 573
 574
 575
 576
 577
 578
 579
 580
 581
 582
 583
 584
 585
 586
 587
 588
 589
 590
 591
 592
 593
 594
 595
 596
 597
 598
 599
 600
 601
 602
 603
 604
 605
 606
 607
 608
 609
 610
 611
 612
 613
 614
 615
 616
 617
 618
 619
 620
 621
 622
 623
 624
 625
 626
 627
 628
 629
 630
 631
 632
 633
 634
 635
 636
 637
 638
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655
 656
 657
 658
 659
 660
 661
 662
 663
 664
 665
 666
 667
 668
 669
 670
 671
 672
 673
 674
 675
 676
 677
 678
 679
 680
 681
 682
 683
 684
 685
 686
 687
 688
 689
 690
 691
 692
 693
 694
 695
 696
 697
 698
 699
 700
 701
 702
 703
 704
 705
 706
 707
 708
 709
 710
 711
 712
 713
 714
 715
 716
 717
 718
 719
 720
 721
 722
 723
 724
 725
 726
 727
 728
 729
 730
 731
 732
 733
 734
 735
 736
 737
 738
 739
 740
 741
 742
 743
 744
 745
 746
 747
 748
 749
 750
 751
 752
 753
 754
 755
 756
 757
 758
 759
 760
 761
 762
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
;;; -*-Emacs-Lisp-*-
;;;%Header
;;;
;;; Rcs_Info: completer.el,v 3.23 1993/09/03 02:05:07 ivan Rel $
;;;
;;; Partial completion mechanism for GNU Emacs.  Version 3.03
;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
;;; Thanks to Bjorn Victor for suggestions, testing, and patches for
;;; file completion. 

;;; This file is part of GNU Emacs.

;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY.  No author or distributor
;;; accepts responsibility to anyone for the consequences of using it
;;; or for whether it serves any particular purpose or works at all,
;;; unless he says so in writing.  Refer to the GNU Emacs General Public
;;; License for full details.
;;; Everyone is granted permission to copy, modify and redistribute
;;; GNU Emacs, but only under the conditions described in the
;;; GNU Emacs General Public License.   A copy of this license is
;;; supposed to have been given to you along with GNU Emacs so you
;;; can know your rights and responsibilities.  It should be in a
;;; file named COPYING.  Among other things, the copyright notice
;;; and this notice must be preserved on all copies.

;;; When loaded, this file extends the standard completion mechanisms
;;; so that they perform pattern matching completions.  There is also
;;; an interface that allows it to be used by other programs.  The
;;; completion rules are:
;;;
;;; 1) If what has been typed matches any possibility, do normal
;;; completion. 
;;;
;;; 2) Otherwise, generate a regular expression such that
;;; completer-words delimit words and generate all possible matches.
;;; The variable completer-any-delimiter can be set to a character
;;; that matches any delimiter.  If it were " ", then "by  d" would be 
;;; byte-recompile-directory.  If completer-use-words is T, a match is
;;; unique if it is the only one with the same number of words.  If
;;; completer-use-words is NIL, a match is unique if it is the only
;;; possibility.  If you ask the completer to use its best guess, it
;;; will be the shortest match of the possibilities unless
;;; completer-exact is T.
;;;
;;; 3) For filenames, if completer-complete-filenames is T, each
;;; pathname component will be individually completed, otherwise only
;;; the final component will be completed.  If you are using a
;;; distributed file system like afs, you may want to set up a
;;; symbolic link in your home directory or add pathname components to
;;; completer-file-skip so that the pathname components that go across
;;; machines do not get expanded.
;;;
;;; SPACE, TAB, LFD, RET, and ? do normal completion if possible
;;; otherwise they do partial completion.  In addition, C-DEL will
;;; undo the last partial expansion or contraction.  M-RET will always
;;; complete to the current match before returning.  This is useful
;;; when any string is possible, but you want to complete to a string
;;; as when calling find-file.  The bindings can be changed by using
;;; completer-load-hook.
;;;
;;; Modes that use comint-dynamic-complete (like cmushell and ilisp)
;;; will also do partial completion as will M-tab in Emacs LISP.
;;;
;;; Examples:
;;; a-f     auto-fill-mode
;;; b--d    *beginning-of-defun or byte-recompile-directory
;;; by  d   *byte-recompile-directory if completer-any-delimiter is " "
;;; ~/i.e   *~/ilisp.el or ~/il-el.el or ~/ilisp.elc
;;; /u/mi/  /usr/misc/
;;;


(require 'cl)

;;;%Globals
;;;%%Switches
(defvar completer-load-hook nil
  "Hook called when minibuffer partial completion is loaded.")

(defvar completer-disable nil
  "*If T, turn off partial completion.  Use the command
\\[completer-toggle] to set this.")

(defvar completer-complete-filenames t
  "*If T, then each component of a filename will be completed,
otherwise just the final component will be completed.")

(defvar completer-use-words nil ; jwz: this is HATEFUL!
  "*If T, then prefer completions with the same number of words as the
pattern.")

(defvar completer-words "---. <" 
  "*Delimiters used in partial completions.  It should be a set of
characters suitable for inclusion in a [] regular expression.")

(defvar completer-any-delimiter nil
  "*If a character, then a delimiter in the pattern that matches the
character will match any delimiter in completer-words.")

(defvar completer-file-skip "^cs/$\\|@sys\\|.edu/$\\|.gov/$\\|.com/$\\|:/$"
  "*Regular expression for pathname components to not complete.")

(defvar completer-exact nil
  "*If T, then you must have an exact match.  Otherwise, the shortest
string that matches the pattern will be used.")

(defvar completer-cache-size 100
  "*Size of cache to use for partially completed pathnames.")

(defvar completer-use-cache t
  "*Set to nil to disable the partially completed pathname cache.")

;;;%%Internal
(defvar completer-last-pattern ""
  "The last pattern expanded.")

(defvar completer-message nil
  "T if temporary message was just displayed.")

(defvar completer-path-cache nil
  "Cache of (path . choices) for completer.")

(defvar completer-string nil "Last completer string.")
(defvar completer-table nil "Last completer table.")
(defvar completer-pred nil "Last completer pred.")
(defvar completer-mode nil "Last completer mode.")
(defvar completer-result nil "Last completer result.")

(eval-when (eval load compile)
  (if (not (fboundp 'completion-display-completion-list-function))
      (setf completion-display-completion-list-function
	    'display-completion-list)))


;;;%Utilities
(defun completer-message (message &optional point)
  "Display MESSAGE at optional POINT for two seconds."
  (setq point (or point (point-max))
	completer-message t)
  (let ((end
	 (save-excursion
	   (goto-char point)
	   (insert message)
	   (point)))
	(inhibit-quit t))
    (sit-for 2)
    (delete-region point end)
    (if (and quit-flag 
	     ;;(not (eq 'lucid-19 ilisp-emacs-version-id))
	     (not (string-match "Lucid" emacs-version))
	     )
	(setq quit-flag nil
	      unread-command-char 7))))

;;;
(defun completer-deleter (regexp choices &optional keep)
  "Destructively remove strings that match REGEXP in CHOICES.
Return the modified list.  If optional KEEP, then keep entries that
match regexp."
  (let* ((choiceb choices)
	 choicep)
    (if keep
	(progn
	  (while (and choiceb (not (string-match regexp (car choiceb))))
	    (setq choiceb (cdr choiceb)))
	  (setq choicep choiceb)
	  (while (cdr choicep)
	    (if (string-match regexp (car (cdr choicep)))
		(setq choicep (cdr choicep))
		(rplacd choicep (cdr (cdr choicep))))))
	(while (and choiceb (string-match regexp (car choiceb)))
	  (setq choiceb (cdr choiceb)))
	(setq choicep choiceb)
	(while (cdr choicep)
	  (if (string-match regexp (car (cdr choicep)))
	      (rplacd choicep (cdr (cdr choicep)))
	      (setq choicep (cdr choicep)))))
    choiceb))

;;;%%Regexp
(defun completer-regexp (string delimiters any)
  "Convert STRING into a regexp with words delimited by chars in DELIMITERS.
Any delimiter in STRING that is the same as ANY will match any delimiter."
  (let* ((delimiter-reg (concat "[" delimiters "]"))
	 (limit (length string))
	 (pos 0)
	 (regexp "^"))
    (while (and (< pos limit) (string-match delimiter-reg string pos))
      (let* ((begin (match-beginning 0))
	     (end (match-end 0))
	     (delimiter (substring string begin end))
	     (anyp (eq (elt string begin) any)))
	(setq regexp 
	      (format "%s%s[^%s]*%s" 
		      regexp
		      (regexp-quote (substring string pos begin))
		      (if anyp delimiters delimiter)
		      (if anyp delimiter-reg (regexp-quote delimiter)))
	      pos end)))
    (if (<= pos limit)
	(setq regexp (concat regexp 
			     (regexp-quote (substring string pos limit)))))))

;;;
(defun completer-words (regexp string &optional limit)
  "Return the number of words matching REGEXP in STRING up to LIMIT."
  (setq limit (or limit 1000))
  (let ((count 1)
	(pos 0))
    (while (and (string-match regexp string pos) (<= count limit))
      (setq count (1+ count)
	    pos (match-end 0)))
    count))

;;;%Matcher
(defun completer-matches (string choices delimiters any)
    "Return STRING's matches in CHOICES.
DELIMITERS and the wildcard ANY are used  to segment the strings."
    (let* ((regexp (concat "[" delimiters "]"))
	   (from nil)
	   (to 0)
	   (pattern nil)
	   (len (length string))
	   (matches nil)
	   sub sublen choice word wordlen pat)
      ;; Segment pattern
      (while (< (or from 0) len)
	(setq to (or (string-match regexp string (if from (1+ from))) len))
	(if (eq (elt string (or from 0)) completer-any-delimiter)
	    (setq sub (substring string (if from (1+ from) 0) to)
		  sublen (- (length sub)))
	    (setq sub (substring string (or from 0) to)
		  sublen (length sub)))
	(setq pattern (cons (cons sub sublen) pattern)
	      from to))
      (setq pattern (reverse pattern))
      ;; Find choices that match patterns
      (setq regexp (concat "[" delimiters "]"))
      (while choices
	(setq choice (car choices)
	      word pattern 
	      from 0)
	(while (and word from
		    (let* (begin end)
		      (if (< (setq wordlen (cdr (setq pat (car word)))) 0)
			  (setq begin (1+ from)
				end (+ begin (- wordlen)))
			  (setq begin from
				end (+ begin wordlen)))
		      (and (<= end (length choice))
			   (or (zerop wordlen)
			       (string-equal 
				(car pat)
				(substring choice begin end))))))
	  (setq from (string-match regexp choice 
				   (if (and (zerop from) (zerop wordlen))
				       from
				       (1+ from)))
		word (cdr word)))
	(if (not word) (setq matches (cons choice matches)))
	(setq choices (cdr choices)))
      matches))

;;;
(defun completer-choice (string choices delimiters use-words)
  "Return a list with best match of STRING in CHOICES and T if it is unique.
DELIMITERS are used to separate words.  A match is unique if it is the only
possibility or when USE-WORDS the only possibility with the same
number of words.  The shortest string of multiple possibilities will be
the best match."
  (or (if (null (cdr choices)) (cons (car choices) t))
      (let* ((regexp (concat "[^" delimiters "]*[" delimiters "]"))
	     (words (if use-words (completer-words regexp string)))
	     (choice choices)
	     (unique-p nil)
	     (match nil)
	     (match-count nil)
	     (match-len 1000))
	(while choice
	  (let* ((current (car choice))
		 (length (length current)))
	    (if match-count
		(if (= (completer-words regexp current words) words)
		    (progn
		      (setq unique-p nil)
		      (if (< length match-len)
			  (setq match current
				match-len length))))
		(if (and use-words 
			 (= (completer-words regexp current words) words))
		    (setq match current
			  match-len length
			  match-count t
			  unique-p t)
		    (if (< length match-len)
			(setq match current
			      match-len length)))))
	  (setq choice (cdr choice)))
	(cons match unique-p))))

;;;%Completer
;;;%%Utilities
(defun completer-region (delimiters)
  "Return the completion region bounded by characters in DELIMITERS.
The search is for the current buffer assuming that point is in it."
  (cons (save-excursion (skip-chars-backward delimiters) (point))
	(save-excursion (skip-chars-forward delimiters) (point))))
	 
;;;
(defun completer-last-component (string)
  "Return the start of the last filename component in STRING."
  (let ((last (1- (length string)) )
	(match 0)
	(end 0))
    (while (and (setq match (string-match "/" string end)) (< match last))
      (setq end (1+ match)))
    end))

;;;
(defun completer-match-record (string matches delimiters any dir mode)
  "Return (match lcs choices unique) for STRING in MATCHES.
DELIMITERS or ANY wildcards and DIR if a filename when in MODE."
  (let ((pattern (if dir
		     (substring string (completer-last-component string))
		     string))
	match)
    (setq matches (completer-matches pattern matches delimiters any)
	  match (try-completion pattern (mapcar 'list matches)))
    ;; If try-completion produced an exact match for an element in 'matches',
    ;; then remove any partial matches from 'matches' and set the unique
    ;; match flag.
    (and (stringp match) (member match matches) (setq matches (list match)))
    (if (cdr matches)
	(let ((lcs (concat dir (try-completion "" (mapcar 'list matches)))))
	  (setq match (if (not completer-exact)
			  (completer-choice
			   pattern matches delimiters completer-use-words)))
	  (list (if match (concat dir (car match)))
		lcs
		matches
		(cdr match)))
      (if matches
	  (progn (setq match (concat dir (car matches)))
		 (list match match matches t))
	(list nil nil nil nil)))))

;;;%%Complete file
(defun completer-extension-regexp (extensions)
  "Return a regexp that matches a string ending with any string in EXTENSIONS."
  (concat "\\(" (mapconcat 'regexp-quote extensions "\\|") "\\)\\'"))

;;;
(defun completer-flush ()
  "Flush completer's pathname cache."
  (interactive)
  (setq completer-path-cache nil))

;;;
(defun completer-cache (path pred words any mode)
  "Check to see if PATH is in path cache with PRED, WORDS, ANY and MODE."
  (let* ((last nil)
	 (ptr completer-path-cache)
	 (size 0) 
	 (result nil))
    (if completer-use-cache
	(while ptr
	  (let ((current (car (car ptr))))
	    (if (string-equal current path)
		(progn
		  (if last
		      (progn
			(rplacd last (cdr ptr))
			(rplacd ptr completer-path-cache)
			(setq completer-path-cache ptr)))
		  (setq result (cdr (car ptr))
			ptr nil))
	      (if (cdr ptr) (setq last ptr))
	      (setq size (1+ size)
		    ptr (cdr ptr))))))
    (or result
	(let* ((choices 
		(completer path 'read-file-name-internal pred words any
			   mode t)))
	  (if (and (or (car (cdr (cdr (cdr choices))))
		       (string= path (car choices)))
		   (eq (elt (car choices) (1- (length (car choices)))) ?/))
	      (progn 
		(if (>= size completer-cache-size) (rplacd last nil))
		(setq completer-path-cache 
		      (cons (cons path choices) completer-path-cache))))
	  choices))))

;;;
(defun completer-file (string pred words any mode)
  "Return (match common-substring matches unique-p) for STRING.
It uses 'READ-FILE-NAME-INTERNAL' for choices that pass PRED using WORDS to
delimit words.  Optional ANY is a delimiter that matches any of the
delimiters in WORD.  If optional MODE is nil or 'help then possible
matches will always be returned."
  (let* ((case-fold-search completion-ignore-case)
	 (last (and (eq mode 'exit-ok) (completer-last-component string)))
	 (position
	  ;; Special hack for CMU RFS filenames
	  (if (string-match "^/\\.\\./[^/]*/" string)
	      (match-end 0)
	      (string-match "[^~/]" string)))
	 (new (substring string 0 position))
	 (user (if (string= new "~")
		   (setq new (file-name-directory (expand-file-name new)))))
	 (words (concat words "/"))
	 (len (length string))
	 (choices nil)
	 end
	 (old-choices (list nil nil nil nil)))
    (while position
      (let* ((begin (string-match "/" string position))
	     (exact-p nil))
	(setq end (if begin (match-end 0))
	      choices
	      ;; Ends with a /, so check files in directory
	      (if (and (memq mode '(nil help)) (= position len))
		  (completer-match-record 
		   ""
		   ;; This assumes that .. and . come at the end
		   (let* ((choices
			   (all-completions new 'read-file-name-internal))
			  (choicep choices))
		     (if (string= (car choicep) "../")
			 (cdr (cdr choicep))
			 (while (cdr choicep)
			   (if (string= (car (cdr choicep)) "../")
			       (rplacd choicep nil))
			   (setq choicep (cdr choicep)))
			 choices))
		   words any new mode)
		  (if (eq position last)
		      (let ((new (concat new (substring string position))))
			(list new new nil t))
		      (let ((component (substring string position end)))
			(if (and end
				 (string-match completer-file-skip component))
			    ;; Assume component is complete
			    (list (concat new component) 
				  (concat new component)
				  nil t)
			    (completer-cache
			     (concat new component)
			     pred words any mode))))))
	;; Keep going if unique or we match exactly
	(if (or (car (cdr (cdr (cdr choices))))
		(setq exact-p
		      (string= (concat new (substring string position end))
			       (car choices))))
	    (setq old-choices
		  (let* ((lcs (car (cdr choices)))
			 (matches (car (cdr (cdr choices))))
			 (slash (and lcs (string-match "/$" lcs))))
		    (list nil
			  (if slash (substring lcs 0 slash) lcs)
			  (if (and (cdr matches) 
				   (or (eq mode 'help) (not exact-p)))
			      matches)
			  nil))
		  new (car choices)
		  position end)
	    ;; Its ok to not match user names because they may be in
	    ;; different root directories
	    (if (and (= position 1) (= (elt string 0) ?~))
		(setq new (substring string 0 end)
		      choices (list new new (list new) t)
		      user nil
		      position end)
		(setq position nil)))))
    (if (not (car choices))
	(setq choices old-choices))
    (if (and (car choices)
	     (not (eq mode 'help))
	     (not (car (cdr (cdr (cdr choices))))))
	;; Try removing completion ignored extensions
	(let* ((extensions
		(completer-extension-regexp completion-ignored-extensions))
	       (choiceb (car (cdr (cdr choices))))
	       (choicep choiceb)
	       (isext nil)
	       (noext nil))
	  (while choicep
	    (if (string-match extensions (car choicep))
		(setq isext t)
		(setq noext t))
	    (if (and isext noext)
		;; There are matches besides extensions
		(setq choiceb (completer-deleter extensions choiceb)
		      choicep nil)
		(setq choicep (cdr choicep))))
	  (if (and isext noext)
	      (setq choices
		    (completer-match-record 
		     (if end (substring string end) "")
		     choiceb words any
		     (file-name-directory (car (cdr choices)))
		     mode)))))
    (if user
	(let ((match (car choices))
	      (lcs (car (cdr choices)))
	      (len (length user)))
	  (setq choices
		(cons (if match (concat "~" (substring match len)))
		      (cons (if lcs (concat "~" (substring lcs len)))
			    (cdr (cdr choices)))))))
    choices))

;;;%Exported program interface
;;;%%Completer
(defun completer (string table pred words
			 &optional any mode file-p)
  "Return (match common-substring matches unique-p) for STRING in TABLE.
The choices must also pass PRED using WORDS to delimit words.  If the
flag 'COMPLETER-COMPLETE-FILENAMES' is T and the table is
'READ-FILE-NAME-INTERNAL', then filename components will be individually
expanded.  Optional ANY is a delimiter that can match any delimiter in
WORDS.  Optional MODE is nil for complete, 'help for help and 'exit
for exit."
  (if (and (stringp completer-string) 
	   (string= string completer-string)
	   (eq table completer-table)
	   (eq pred completer-pred)
	   (not file-p)
	   (or (eq mode completer-mode)
	       (not (memq table '(read-file-name-internal
				  read-directory-name-internal)))))
      completer-result
      (setq 
       completer-string ""
       completer-table table
       completer-pred pred
       completer-mode mode
       completer-result
       (if (and completer-complete-filenames
		(not file-p) (eq table 'read-file-name-internal))
	   (completer-file string pred words any mode)
	   (let* ((file-p (or file-p (eq table 'read-file-name-internal)))
		  (case-fold-search completion-ignore-case)
		  (pattern (concat "[" words "]"))
		  (component (if file-p (completer-last-component string)))
		  (dir (if component (substring string 0 component)))
		  (string (if dir (substring string component) string))
		  (has-words (or (string-match pattern string)
				 (length string))))
	     (if (and file-p (string-match "^\\$" string))
		 ;; Handle environment variables
		 (let ((match
			(getenv (substring string 1 
					   (string-match "/" string)))))
		   (if match (setq match (concat match "/")))
		   (list match match (list match) match))
		 (let* ((choices
			 (all-completions 
			  (concat dir (substring string 0 has-words))
			  table pred))
			(regexp (completer-regexp string words any)))
		   (if choices
		       (completer-match-record 
			string 
			(completer-deleter regexp choices t) 
			words any dir mode)
		       (list nil nil nil nil))))))
       completer-string string)
      completer-result))

;;;%%Display choices
(defun completer-display-choices (choices &optional match message end
					  display)
  "Display the list of possible CHOICES.
MATCH, MESSAGE, END and DISPLAY are used optionally.  If MATCH is
non-nil, it will be flagged as the best guess.  If there are no
choices, display MESSAGE.  END is where to put temporary messages.  If
DISPLAY is present then it will be called on each possible completion
and should return a string."

  (if choices
      (with-output-to-temp-buffer "*Completions*"
	(if (cdr choices) 
	    (funcall completion-display-completion-list-function
	     (sort
	      (if display
		  (let ((old choices)
			(new nil))
		    (while old
		      (setq new (cons (funcall display (car old)) new)
			    old (cdr old)))
		    new)
		(copy-sequence choices))
	      (function (lambda (x y)
			  (string-lessp (or (car-safe x) x)
					(or (car-safe y) y)))))))
	(if match
	    (save-excursion
	      (set-buffer "*Completions*")
	      (goto-char (point-min))
	      (let ((buffer-read-only nil))
		(insert "Guess = " match (if (cdr choices) ", " "") "\n")))))
      (beep)
      (completer-message (or message " (No completions)") end)))

;;;%%Goto
(defun completer-goto (match lcs choices unique delimiters words 
			     &optional mode display)
  "Go to the part of the string that disambiguates CHOICES.
MATCH is the best match, LCS is the longest common substring of all
of the matches.  CHOICES is a list of the possibilities, UNIQUE
indicates if MATCH is unique.  DELIMITERS are possible bounding
characters for the completion region.  WORDS are the characters that
delimit the words for partial matches.  Replace the region bounded by
delimiters with the match if unique and the lcs otherwise unless
optional MODE is 'help.  Then go to the part of the string that
disambiguates CHOICES using WORDS to separate words and display the
possibilities if the string was not extended.  If optional DISPLAY is
present then it will be called on each possible completion and should
return a string."
  (setq completer-message nil)
  (let* ((region (completer-region delimiters))
	 (start (car region))
	 (end (cdr region))
	 (string (buffer-substring start end))
	 (file-p (string-match "[^ ]*\\(~\\|/\\|$\\)" string))
	 (no-insert (eq mode 'help))
	 (message t)
	 (new (not (string= (buffer-substring start (point)) lcs))))
    (if unique
	(if no-insert
	    (progn
	      (goto-char end)
	      (completer-display-choices choices match nil end display))
	    (if (string= string match)
		(if (not file-p) 
		    (progn (goto-char end)
			   (completer-message " (Sole completion)" end)))
		(completer-insert match delimiters)))
	;;Not unique
	(if lcs
	    (let* ((regexp 
		    (concat "[" words (if file-p "/") "]"))
		   (words (completer-words regexp lcs))
		   point)
	      ;; Go to where its ambiguous
	      (goto-char start)
	      (if (not no-insert)
		  (progn 
		    (insert lcs)
		    (setq completer-last-pattern 
			  (list string delimiters (current-buffer) start)
			  start (point)
			  end (+ end (length lcs)))))
	      ;; Skip to the first delimiter in the original string
	      ;; beyond the ambiguous point and keep from there on
	      (if (re-search-forward regexp end 'move words)
		  (progn
		    (if (and (not no-insert) match)
			(let ((delimiter
			       (progn
				 (string-match (regexp-quote lcs) match)
				 (substring match (match-end 0)
					    (1+ (match-end 0))))))
			  (if (string-match regexp delimiter)
			      (insert delimiter))))
		    (forward-char -1)))
	      (if (not no-insert) 
		  (progn
		    (setq end (- end (- (point) start)))
		    (delete-region start (point))))))
	(if choices
	    (if (or no-insert (not new))
		(completer-display-choices choices match nil end display))
	    (if file-p 
		(progn 
		  (if (not (= (point) end)) (forward-char 1))
		  (if (not (save-excursion (re-search-forward "/" end t)))
		      (goto-char end))))
	    (if message
		(progn
		  (beep)
		  (completer-message (if no-insert 
					 " (No completions)"
					 " (No match)")
				     end)))))))	    

;;;%Exported buffer interface
;;;%%Complete and go
(defun completer-complete-goto (delimiters words table pred 
					   &optional no-insert display)
  "Complete the string bound by DELIMITERS using WORDS to bound words
for partial matches in TABLE with PRED and then insert the longest
common substring unless optional NO-INSERT and go to the point of
ambiguity.  If optional DISPLAY, it will be called on each match when
possible completions are shown and should return a string."
  (let* ((region (completer-region delimiters)))
    (apply 'completer-goto 
	   (append (completer (buffer-substring (car region) (cdr region))
			      table pred words completer-any-delimiter
			      no-insert)
		  (list delimiters words no-insert display)))))

;;;%%Undo
(defun completer-insert (match delimiters &optional buffer undo)
  "Replace the region bounded with characters in DELIMITERS by MATCH.
Then save it so that it can be restored by completer-undo."
  (let* ((region (completer-region delimiters))
	 (start (car region))
	 (end (cdr region)))
    (if (and undo (or (not (= start undo)) 
		      (not (eq (current-buffer) buffer))))
	(error "No previous pattern")
	(setq completer-last-pattern (list (buffer-substring start end) 
					   delimiters
					   (current-buffer)
					   start))
	(delete-region start end)
	(goto-char start)
	(insert match))))

;;;
(defun completer-undo ()
  "Swap the last expansion and the last match pattern."
  (interactive)
  (if completer-last-pattern
      (apply 'completer-insert completer-last-pattern)
      (error "No previous pattern")))

;;;%Minibuffer specific code
;;;%%Utilities
(defun completer-minibuf-string ()
  "Remove dead filename specs from the minibuffer.
Dead filename should be delimited by // or ~ or $ and return the
resulting string."
  (save-excursion
    (goto-char (point-max))
    (if (and (eq minibuffer-completion-table 'read-file-name-internal)
	     (re-search-backward "//\\|/~\\|.\\$" nil t))
	(delete-region (point-min) (1+ (point))))
    (buffer-substring (point-min) (point-max))))

;;;
(defun completer-minibuf-exit ()
  "Exit the minibuffer and clear completer-last-pattern."
  (interactive)
  (setq completer-last-pattern nil)
  (exit-minibuffer))

;;;
(defun completer-new-cmd (cmd)
  "Return T if we can't execute the old minibuffer version of CMD."
  (if (or completer-disable
	  (let ((string (completer-minibuf-string)))
	    (or
	     (not (string-match
		   (concat "[" completer-words "/~]")
		   string))
	      (condition-case ()
		  (let ((completion
			 (try-completion string
					 minibuffer-completion-table
					 minibuffer-completion-predicate)))
		    (if (eq minibuffer-completion-table
			    'read-file-name-internal)
			;; Directories complete as themselves
			(and completion
			     (or (not (string= string completion))
				 (file-exists-p completion)))
			completion))
		(error nil)))))
      (progn
	(funcall cmd)
	nil)
      t))

;;;
(defun completer-minibuf (&optional mode)
  "Partial completion of minibuffer expressions.
Optional MODE is (quote help) for help and (quote exit) for exit.

If what has been typed so far matches any possibility normal
completion will be done.  Otherwise, the string is considered to be a
pattern with words delimited by the characters in
completer-words.  If completer-exact is T, the best match will be
the shortest one with the same number of words as the pattern if
possible and otherwise the shortest matching expression.  If called
with a prefix, caching will be temporarily disabled.

Examples:
a-f     auto-fill-mode
r-e     rmail-expunge
b--d    *begining-of-defun or byte-recompile-directory
by  d   *byte-recompile-directory if completer-any-delimiter is \" \"
~/i.e   *~/ilisp.el or ~/il-el.el or ~/ilisp.elc
/u/mi/  /usr/misc/"
  (interactive)
  (append
   (let ((completer-use-cache (not (or (not completer-use-cache)
				       current-prefix-arg))))
     (completer (completer-minibuf-string)
		minibuffer-completion-table
		minibuffer-completion-predicate
		completer-words
		completer-any-delimiter
		mode))
   (list "^" completer-words mode)))

;;;%%Commands
(defun completer-toggle ()
  "Turn partial completion on or off."
  (interactive)
  (setq completer-disable (not completer-disable))
  (message (if completer-disable 
	       "Partial completion OFF"
	       "Partial completion ON")))

;;;
(defvar completer-old-help
  (lookup-key minibuffer-local-must-match-map "?")
  "Old binding of ? in minibuffer completion map.")
(defun completer-help ()
  "Partial completion minibuffer-completion-help.  
See completer-minibuf for more information."
  (interactive)
  (if (completer-new-cmd completer-old-help)
      (apply 'completer-goto (completer-minibuf 'help))))

;;;
(defvar completer-old-completer
  (lookup-key minibuffer-local-must-match-map "\t")
  "Old binding of TAB in minibuffer completion map.")

(defun completer-complete ()
  "Partial completion minibuffer-complete.
See completer-minibuf for more information."
  (interactive)
  (if (completer-new-cmd completer-old-completer)
      (apply 'completer-goto (completer-minibuf))))

;;;
(defvar completer-old-word
  (lookup-key minibuffer-local-must-match-map " ")
  "Old binding of SPACE in minibuffer completion map.")
(defun completer-word ()
  "Partial completion minibuffer-complete.
See completer-minibuf for more information."
  (interactive)
  (if (eq completer-any-delimiter ?\ )
      (insert ?\ )
      (if (completer-new-cmd completer-old-word)
	  (apply 'completer-goto (completer-minibuf)))))

;;; 
(defvar completer-old-exit
  (lookup-key minibuffer-local-must-match-map "\n")
  "Old binding of RET in minibuffer completion map.")
(defun completer-exit ()
  "Partial completion minibuffer-complete-and-exit.
See completer-minibuf for more information."
  (interactive)
  (if (completer-new-cmd completer-old-exit)
      (let* ((completions (completer-minibuf 'exit))
	     (match (car completions))
	     (unique-p (car (cdr (cdr (cdr completions))))))
	(apply 'completer-goto completions)
	(if unique-p
	    (completer-minibuf-exit)
	    (if match
		(progn (completer-insert match "^")
		       (if minibuffer-completion-confirm
			   (completer-message " (Confirm)")
			   (completer-minibuf-exit)))
		(if (not completer-message) (beep)))))))

;;;
(defun completer-match-exit ()
  "Exit the minibuffer with the current best match."
  (interactive)
  (let* ((completions (completer-minibuf 'exit))
	 (guess (car completions)))
    (if (not guess) 
	;; OK if last filename component doesn't match
	(setq completions (completer-minibuf 'exit-ok)
	      guess (car completions)))
    (if guess
	(progn
	  (goto-char (point-min))
	  (insert guess)
	  (delete-region (point) (point-max))
	  (exit-minibuffer))
	(apply 'completer-goto completions))))

;;;%%Keymaps
;this interferes with normal undo.
;(define-key minibuffer-local-completion-map "\C-_"  'completer-undo)
(define-key minibuffer-local-completion-map "\t"    'completer-complete)
(define-key minibuffer-local-completion-map " "     'completer-word)
(define-key minibuffer-local-completion-map "?"     'completer-help)
(define-key minibuffer-local-completion-map "\n"    'completer-minibuf-exit)
(define-key minibuffer-local-completion-map "\r"    'completer-minibuf-exit)
(define-key minibuffer-local-completion-map "\M-\n" 'completer-match-exit)
(define-key minibuffer-local-completion-map "\M-\r" 'completer-match-exit)

;this interferes with normal undo.
;(define-key minibuffer-local-must-match-map "\C-_"  'completer-undo)
(define-key minibuffer-local-must-match-map "\t"    'completer-complete)
(define-key minibuffer-local-must-match-map " "     'completer-word)
(define-key minibuffer-local-must-match-map "\n"    'completer-exit)
(define-key minibuffer-local-must-match-map "\r"    'completer-exit)
(define-key minibuffer-local-must-match-map "?"     'completer-help)
(define-key minibuffer-local-must-match-map "\M-\n" 'completer-match-exit)
(define-key minibuffer-local-must-match-map "\M-\r" 'completer-match-exit)

;;;%comint 
(defun completer-comint-dynamic-list-completions (completions)
  "List in help buffer sorted COMPLETIONS.
Typing SPC flushes the help buffer."
  (completer-comint-dynamic-complete-1 nil 'help))

(defun completer-comint-dynamic-complete-filename ()
  "Dynamically complete the filename at point."
  (interactive)
  (completer-comint-dynamic-complete-1 nil t))

;;;
(defun completer-comint-dynamic-complete-1 (&optional undo mode)
  "Complete the previous filename or display possibilities if done
twice in a row.  If called with a prefix, undo the last completion."
  (interactive "P")
  (if undo
      (completer-undo)
    ;; added by jwz: don't cache completions in shell buffer!
    (setq completer-string nil)
    (let ((conf (current-window-configuration)));; lemacs change
      (completer-complete-goto 
       "^ \t\n\""
       completer-words
       'read-file-name-internal
       default-directory
       mode)
      ;; lemacs change
      (if (eq mode 'help) (comint-restore-window-config conf))
      )))
;(fset 'comint-dynamic-complete 'completer-comint-dynamic-complete)
(fset 'comint-dynamic-complete-filename
      'completer-comint-dynamic-complete-filename)
(fset 'comint-dynamic-list-completions 
      'completer-comint-dynamic-list-completions)

;;; Set the functions again if comint is loaded
(setq comint-load-hook 
      (cons (function (lambda ()
;;	      (fset 'comint-dynamic-complete 
;;		    'completer-comint-dynamic-complete)
			(fset 'comint-dynamic-complete-filename
			      'completer-comint-dynamic-complete-filename)
	      (fset 'comint-dynamic-list-completions 
		    'completer-comint-dynamic-list-completions)))
	    (if (and (boundp 'comint-load-hook) comint-load-hook)
		(if (consp comint-load-hook) 
		    (if (eq (car comint-load-hook) 'lambda)
			(list comint-load-hook)
			comint-load-hook)
		    (list comint-load-hook)))))

;;;%lisp-complete-symbol
(defun lisp-complete-symbol (&optional mode)
  "Perform partial completion on Lisp symbol preceding point.
That symbol is compared against the symbols that exist and any additional
characters determined by what is there are inserted.  If the symbol
starts just after an open-parenthesis, only symbols with function
definitions are considered.  Otherwise, all symbols with function
definitions, values or properties are considered.  If called with a
negative prefix, the last completion will be undone."
  (interactive "P")
  (if (< (prefix-numeric-value mode) 0)
      (completer-undo)
      (let* ((end (save-excursion (skip-chars-forward "^ \t\n)]}\"") (point)))
	     (beg (save-excursion
		    (backward-sexp 1)
		    (while (= (char-syntax (following-char)) ?\')
		      (forward-char 1))
		    (point)))
	     (pattern (buffer-substring beg end))
	     (predicate
	      (if (eq (char-after (1- beg)) ?\()
		  'fboundp
		  (function (lambda (sym)
		    (or (boundp sym) (fboundp sym)
			(symbol-plist sym))))))
	     (completion (try-completion pattern obarray predicate)))
	   (cond ((eq completion t))
	      ((null completion)
	       (completer-complete-goto
		"^ \t\n\(\)[]{}'`" completer-words
		obarray predicate 
		nil
		(if (not (eq predicate 'fboundp))
		    (function (lambda (choice)
		      (if (fboundp (intern choice))
			  (list choice " <f>")
			  choice))))))
	      ((not (string= pattern completion))
	       (delete-region beg end)
	       (insert completion))
	      (t
	       (message "Making completion list...")
	       (let ((list (all-completions pattern obarray predicate)))
		 (or (eq predicate 'fboundp)
		     (let (new)
		       (while list
			 (setq new (cons (if (fboundp (intern (car list)))
					     (list (car list) " <f>")
					     (car list))
					 new))
			 (setq list (cdr list)))
		       (setq list (nreverse new))))
		 (with-output-to-temp-buffer "*Help*"
		   (funcall completion-display-completion-list-function
		    (sort list (function (lambda (x y)
					   (string-lessp
					    (or (car-safe x) x)
					    (or (car-safe y) y))))))))
	       (message "Making completion list...%s" "done"))))))

;;;%Hooks
(provide 'completer)
(run-hooks 'completer-load-hook)

;;; end of file -- completer.el --
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.