Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
marvel
GitHub Repository: marvel/qnf
Path: blob/master/elisp/auto-complete.el
987 views
1
;;; auto-complete.el --- Auto Completion for GNU Emacs
2
3
;; Copyright (C) 2008, 2009, 2010 Tomohiro Matsuyama
4
5
;; Author: Tomohiro Matsuyama <[email protected]>
6
;; URL: http://cx4a.org/software/auto-complete
7
;; Keywords: completion, convenience
8
;; Version: 1.3
9
10
;; This program is free software; you can redistribute it and/or modify
11
;; it under the terms of the GNU General Public License as published by
12
;; the Free Software Foundation, either version 3 of the License, or
13
;; (at your option) any later version.
14
15
;; This program is distributed in the hope that it will be useful,
16
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18
;; GNU General Public License for more details.
19
20
;; You should have received a copy of the GNU General Public License
21
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22
23
;;; Commentary:
24
;;
25
;; This extension provides a way to complete with popup menu like:
26
;;
27
;; def-!-
28
;; +-----------------+
29
;; |defun::::::::::::|
30
;; |defvar |
31
;; |defmacro |
32
;; | ... |
33
;; +-----------------+
34
;;
35
;; You can complete by typing and selecting menu.
36
;;
37
;; Entire documents are located in doc/ directory.
38
;; Take a look for information.
39
;;
40
;; Enjoy!
41
42
;;; Code:
43
44
45
46
(eval-when-compile
47
(require 'cl))
48
49
(require 'popup)
50
51
;;;; Global stuff
52
53
(defun ac-error (&optional var)
54
"Report an error and disable `auto-complete-mode'."
55
(ignore-errors
56
(message "auto-complete error: %s" var)
57
(auto-complete-mode -1)
58
var))
59
60
61
62
;;;; Customization
63
64
(defgroup auto-complete nil
65
"Auto completion."
66
:group 'completion
67
:prefix "ac-")
68
69
(defcustom ac-delay 0.1
70
"Delay to completions will be available."
71
:type 'float
72
:group 'auto-complete)
73
74
(defcustom ac-auto-show-menu 0.8
75
"Non-nil means completion menu will be automatically shown."
76
:type '(choice (const :tag "Yes" t)
77
(const :tag "Never" nil)
78
(float :tag "Timer"))
79
:group 'auto-complete)
80
81
(defcustom ac-show-menu-immediately-on-auto-complete t
82
"Non-nil means menu will be showed immediately on `auto-complete'."
83
:type 'boolean
84
:group 'auto-complete)
85
86
(defcustom ac-expand-on-auto-complete t
87
"Non-nil means expand whole common part on first time `auto-complete'."
88
:type 'boolean
89
:group 'auto-complete)
90
91
(defcustom ac-disable-faces '(font-lock-comment-face font-lock-string-face font-lock-doc-face)
92
"Non-nil means disable automatic completion on specified faces."
93
:type '(repeat symbol)
94
:group 'auto-complete)
95
96
(defcustom ac-stop-flymake-on-completing t
97
"Non-nil means disble flymake temporarily on completing."
98
:type 'boolean
99
:group 'auto-complete)
100
101
(defcustom ac-use-fuzzy t
102
"Non-nil means use fuzzy matching."
103
:type 'boolean
104
:group 'auto-complete)
105
106
(defcustom ac-fuzzy-cursor-color "red"
107
"Cursor color in fuzzy mode."
108
:type 'string
109
:group 'auto-complete)
110
111
(defcustom ac-use-comphist t
112
"Non-nil means use intelligent completion history."
113
:type 'boolean
114
:group 'auto-complete)
115
116
(defcustom ac-comphist-threshold 0.7
117
"Percentage of ignoring low scored candidates."
118
:type 'float
119
:group 'auto-complete)
120
121
(defcustom ac-comphist-file
122
(expand-file-name (concat (if (boundp 'user-emacs-directory)
123
user-emacs-directory
124
"~/.emacs.d/")
125
"/ac-comphist.dat"))
126
"Completion history file name."
127
:type 'string
128
:group 'auto-complete)
129
130
(defcustom ac-use-quick-help t
131
"Non-nil means use quick help."
132
:type 'boolean
133
:group 'auto-complete)
134
135
(defcustom ac-quick-help-delay 1.5
136
"Delay to show quick help."
137
:type 'float
138
:group 'auto-complete)
139
140
(defcustom ac-menu-height 10
141
"Max height of candidate menu."
142
:type 'integer
143
:group 'auto-complete)
144
(defvaralias 'ac-candidate-menu-height 'ac-menu-height)
145
146
(defcustom ac-quick-help-height 20
147
"Max height of quick help."
148
:type 'integer
149
:group 'auto-complete)
150
151
(defcustom ac-quick-help-prefer-x t
152
"Prefer X tooltip than overlay popup for displaying quick help."
153
:type 'boolean
154
:group 'auto-complete)
155
156
(defcustom ac-candidate-limit nil
157
"Limit number of candidates. Non-integer means no limit."
158
:type 'integer
159
:group 'auto-complete)
160
(defvaralias 'ac-candidate-max 'ac-candidate-limit)
161
162
(defcustom ac-modes
163
'(emacs-lisp-mode
164
lisp-interaction-mode
165
c-mode cc-mode c++-mode
166
java-mode clojure-mode scala-mode
167
scheme-mode
168
ocaml-mode tuareg-mode
169
perl-mode cperl-mode python-mode ruby-mode
170
ecmascript-mode javascript-mode js-mode js2-mode php-mode css-mode
171
makefile-mode sh-mode fortran-mode f90-mode ada-mode
172
xml-mode sgml-mode)
173
"Major modes `auto-complete-mode' can run on."
174
:type '(repeat symbol)
175
:group 'auto-complete)
176
177
(defcustom ac-compatible-packages-regexp
178
"^ac-"
179
"Regexp to indicate what packages can work with auto-complete."
180
:type 'string
181
:group 'auto-complete)
182
183
(defcustom ac-trigger-commands
184
'(self-insert-command)
185
"Trigger commands that specify whether `auto-complete' should start or not."
186
:type '(repeat symbol)
187
:group 'auto-complete)
188
189
(defcustom ac-trigger-commands-on-completing
190
'(delete-backward-char
191
backward-delete-char
192
backward-delete-char-untabify)
193
"Trigger commands that specify whether `auto-complete' should continue or not."
194
:type '(repeat symbol)
195
:group 'auto-complete)
196
197
(defcustom ac-trigger-key nil
198
"Non-nil means `auto-complete' will start by typing this key.
199
If you specify this TAB, for example, `auto-complete' will start by typing TAB,
200
and if there is no completions, an original command will be fallbacked."
201
:type 'string
202
:group 'auto-complete
203
:set (lambda (symbol value)
204
(set-default symbol value)
205
(when (and value
206
(fboundp 'ac-set-trigger-key))
207
(ac-set-trigger-key value))))
208
209
(defcustom ac-auto-start 2
210
"Non-nil means completion will be started automatically.
211
Positive integer means if a length of a word you entered is larger than the value,
212
completion will be started automatically.
213
If you specify `nil', never be started automatically."
214
:type '(choice (const :tag "Yes" t)
215
(const :tag "Never" nil)
216
(integer :tag "Require"))
217
:group 'auto-complete)
218
219
(defcustom ac-ignores nil
220
"List of string to ignore completion."
221
:type '(repeat string)
222
:group 'auto-complete)
223
224
(defcustom ac-ignore-case 'smart
225
"Non-nil means auto-complete ignores case.
226
If this value is `smart', auto-complete ignores case only when
227
a prefix doen't contain any upper case letters."
228
:type '(choice (const :tag "Yes" t)
229
(const :tag "Smart" smart)
230
(const :tag "No" nil))
231
:group 'auto-complete)
232
233
(defcustom ac-dwim t
234
"Non-nil means `auto-complete' works based on Do What I Mean."
235
:type 'boolean
236
:group 'auto-complete)
237
238
(defcustom ac-use-menu-map nil
239
"Non-nil means a special keymap `ac-menu-map' on completing menu will be used."
240
:type 'boolean
241
:group 'auto-complete)
242
243
(defcustom ac-use-overriding-local-map nil
244
"Non-nil means `overriding-local-map' will be used to hack for overriding key events on auto-copletion."
245
:type 'boolean
246
:group 'auto-complete)
247
248
(defface ac-completion-face
249
'((t (:foreground "darkgray" :underline t)))
250
"Face for inline completion"
251
:group 'auto-complete)
252
253
(defface ac-candidate-face
254
'((t (:background "lightgray" :foreground "black")))
255
"Face for candidate."
256
:group 'auto-complete)
257
258
(defface ac-selection-face
259
'((t (:background "steelblue" :foreground "white")))
260
"Face for selected candidate."
261
:group 'auto-complete)
262
263
(defvar auto-complete-mode-hook nil
264
"Hook for `auto-complete-mode'.")
265
266
267
268
;;;; Internal variables
269
270
(defvar auto-complete-mode nil
271
"Dummy variable to suppress compiler warnings.")
272
273
(defvar ac-cursor-color nil
274
"Old cursor color.")
275
276
(defvar ac-inline nil
277
"Inline completion instance.")
278
279
(defvar ac-menu nil
280
"Menu instance.")
281
282
(defvar ac-show-menu nil
283
"Flag to show menu on timer tick.")
284
285
(defvar ac-last-completion nil
286
"Cons of prefix marker and selected item of last completion.")
287
288
(defvar ac-quick-help nil
289
"Quick help instance")
290
291
(defvar ac-completing nil
292
"Non-nil means `auto-complete-mode' is now working on completion.")
293
294
(defvar ac-buffer nil
295
"Buffer where auto-complete is started.")
296
297
(defvar ac-point nil
298
"Start point of prefix.")
299
300
(defvar ac-last-point nil
301
"Last point of updating pattern.")
302
303
(defvar ac-prefix nil
304
"Prefix string.")
305
(defvaralias 'ac-target 'ac-prefix)
306
307
(defvar ac-selected-candidate nil
308
"Last selected candidate.")
309
310
(defvar ac-common-part nil
311
"Common part string of meaningful candidates.
312
If there is no common part, this will be nil.")
313
314
(defvar ac-whole-common-part nil
315
"Common part string of whole candidates.
316
If there is no common part, this will be nil.")
317
318
(defvar ac-prefix-overlay nil
319
"Overlay for prefix string.")
320
321
(defvar ac-timer nil
322
"Completion idle timer.")
323
324
(defvar ac-show-menu-timer nil
325
"Show menu idle timer.")
326
327
(defvar ac-quick-help-timer nil
328
"Quick help idle timer.")
329
330
(defvar ac-triggered nil
331
"Flag to update.")
332
333
(defvar ac-limit nil
334
"Limit number of candidates for each sources.")
335
336
(defvar ac-candidates nil
337
"Current candidates.")
338
339
(defvar ac-candidates-cache nil
340
"Candidates cache for individual sources.")
341
342
(defvar ac-fuzzy-enable nil
343
"Non-nil means fuzzy matching is enabled.")
344
345
(defvar ac-dwim-enable nil
346
"Non-nil means DWIM completion will be allowed.")
347
348
(defvar ac-mode-map (make-sparse-keymap)
349
"Auto-complete mode map. It is also used for trigger key command. See also `ac-trigger-key'.")
350
351
(defvar ac-completing-map
352
(let ((map (make-sparse-keymap)))
353
(define-key map "\t" 'ac-expand)
354
(define-key map "\r" 'ac-complete)
355
(define-key map (kbd "M-TAB") 'auto-complete)
356
(define-key map "\C-s" 'ac-isearch)
357
358
(define-key map "\M-n" 'ac-next)
359
(define-key map "\M-p" 'ac-previous)
360
(define-key map [down] 'ac-next)
361
(define-key map [up] 'ac-previous)
362
363
(define-key map [f1] 'ac-help)
364
(define-key map [M-f1] 'ac-persist-help)
365
(define-key map (kbd "C-?") 'ac-help)
366
(define-key map (kbd "C-M-?") 'ac-persist-help)
367
368
(define-key map [C-down] 'ac-quick-help-scroll-down)
369
(define-key map [C-up] 'ac-quick-help-scroll-up)
370
(define-key map "\C-\M-n" 'ac-quick-help-scroll-down)
371
(define-key map "\C-\M-p" 'ac-quick-help-scroll-up)
372
373
(dotimes (i 9)
374
(let ((symbol (intern (format "ac-complete-%d" (1+ i)))))
375
(fset symbol
376
`(lambda ()
377
(interactive)
378
(when (and (ac-menu-live-p) (popup-select ac-menu ,i))
379
(ac-complete))))
380
(define-key map (read-kbd-macro (format "M-%s" (1+ i))) symbol)))
381
382
map)
383
"Keymap for completion.")
384
(defvaralias 'ac-complete-mode-map 'ac-completing-map)
385
386
(defvar ac-menu-map
387
(let ((map (make-sparse-keymap)))
388
(define-key map "\C-n" 'ac-next)
389
(define-key map "\C-p" 'ac-previous)
390
(set-keymap-parent map ac-completing-map)
391
map)
392
"Keymap for completion on completing menu.")
393
394
(defvar ac-current-map
395
(let ((map (make-sparse-keymap)))
396
(set-keymap-parent map ac-completing-map)
397
map))
398
399
(defvar ac-match-function 'all-completions
400
"Default match function.")
401
402
(defvar ac-prefix-definitions
403
'((symbol . ac-prefix-symbol)
404
(file . ac-prefix-file)
405
(valid-file . ac-prefix-valid-file)
406
(c-dot . ac-prefix-c-dot)
407
(c-dot-ref . ac-prefix-c-dot-ref))
408
"Prefix definitions for common use.")
409
410
(defvar ac-sources '(ac-source-words-in-same-mode-buffers)
411
"Sources for completion.")
412
(make-variable-buffer-local 'ac-sources)
413
414
(defvar ac-compiled-sources nil
415
"Compiled source of `ac-sources'.")
416
417
(defvar ac-current-sources nil
418
"Current working sources. This is sublist of `ac-compiled-sources'.")
419
420
(defvar ac-omni-completion-sources nil
421
"Do not use this anymore.")
422
423
(defvar ac-current-prefix-def nil)
424
425
(defvar ac-ignoring-prefix-def nil)
426
427
428
429
;;;; Intelligent completion history
430
431
(defvar ac-comphist nil
432
"Database of completion history.")
433
434
(defsubst ac-comphist-make-tab ()
435
(make-hash-table :test 'equal))
436
437
(defsubst ac-comphist-tab (db)
438
(nth 0 db))
439
440
(defsubst ac-comphist-cache (db)
441
(nth 1 db))
442
443
(defun ac-comphist-make (&optional tab)
444
(list (or tab (ac-comphist-make-tab)) (make-hash-table :test 'equal :weakness t)))
445
446
(defun ac-comphist-get (db string &optional create)
447
(let* ((tab (ac-comphist-tab db))
448
(index (gethash string tab)))
449
(when (and create (null index))
450
(setq index (make-vector (length string) 0))
451
(puthash string index tab))
452
index))
453
454
(defun ac-comphist-add (db string prefix)
455
(setq prefix (min prefix (1- (length string))))
456
(when (<= 0 prefix)
457
(setq string (substring-no-properties string))
458
(let ((stat (ac-comphist-get db string t)))
459
(incf (aref stat prefix))
460
(remhash string (ac-comphist-cache db)))))
461
462
(defun ac-comphist-score (db string prefix)
463
(setq prefix (min prefix (1- (length string))))
464
(if (<= 0 prefix)
465
(let ((cache (gethash string (ac-comphist-cache db))))
466
(or (and cache (aref cache prefix))
467
(let ((stat (ac-comphist-get db string))
468
(score 0.0))
469
(when stat
470
(loop for p from 0 below (length string)
471
;; sigmoid function
472
with a = 5
473
with d = (/ 6.0 a)
474
for x = (- d (abs (- prefix p)))
475
for r = (/ 1.0 (1+ (exp (* (- a) x))))
476
do
477
(incf score (* (aref stat p) r))))
478
;; Weight by distance
479
(incf score (max 0.0 (- 0.3 (/ (- (length string) prefix) 100.0))))
480
(unless cache
481
(setq cache (make-vector (length string) nil))
482
(puthash string cache (ac-comphist-cache db)))
483
(aset cache prefix score)
484
score)))
485
0.0))
486
487
(defun ac-comphist-sort (db collection prefix &optional threshold)
488
(let (result
489
(n 0)
490
(total 0)
491
(cur 0))
492
(setq result (mapcar (lambda (a)
493
(when (and cur threshold)
494
(if (>= cur (* total threshold))
495
(setq cur nil)
496
(incf n)
497
(incf cur (cdr a))))
498
(car a))
499
(sort (mapcar (lambda (string)
500
(let ((score (ac-comphist-score db string prefix)))
501
(incf total score)
502
(cons string score)))
503
collection)
504
(lambda (a b) (< (cdr b) (cdr a))))))
505
(if threshold
506
(cons n result)
507
result)))
508
509
(defun ac-comphist-serialize (db)
510
(let (alist)
511
(maphash (lambda (k v)
512
(push (cons k v) alist))
513
(ac-comphist-tab db))
514
(list alist)))
515
516
(defun ac-comphist-deserialize (sexp)
517
(condition-case nil
518
(ac-comphist-make (let ((tab (ac-comphist-make-tab)))
519
(mapc (lambda (cons)
520
(puthash (car cons) (cdr cons) tab))
521
(nth 0 sexp))
522
tab))
523
(error (message "Invalid comphist db.") nil)))
524
525
(defun ac-comphist-init ()
526
(ac-comphist-load)
527
(add-hook 'kill-emacs-hook 'ac-comphist-save))
528
529
(defun ac-comphist-load ()
530
(interactive)
531
(let ((db (if (file-exists-p ac-comphist-file)
532
(ignore-errors
533
(with-temp-buffer
534
(insert-file-contents ac-comphist-file)
535
(goto-char (point-min))
536
(ac-comphist-deserialize (read (current-buffer))))))))
537
(setq ac-comphist (or db (ac-comphist-make)))))
538
539
(defun ac-comphist-save ()
540
(interactive)
541
(require 'pp)
542
(ignore-errors
543
(with-temp-buffer
544
(pp (ac-comphist-serialize ac-comphist) (current-buffer))
545
(write-region (point-min) (point-max) ac-comphist-file))))
546
547
548
549
;;;; Auto completion internals
550
551
(defun ac-menu-at-wrapper-line-p ()
552
"Return non-nil if current line is long and wrapped to next visual line."
553
(and (not truncate-lines)
554
(eq (line-beginning-position)
555
(save-excursion
556
(vertical-motion 1)
557
(line-beginning-position)))))
558
559
(defun ac-prefix-symbol ()
560
"Default prefix definition function."
561
(require 'thingatpt)
562
(car-safe (bounds-of-thing-at-point 'symbol)))
563
(defalias 'ac-prefix-default 'ac-prefix-symbol)
564
565
(defun ac-prefix-file ()
566
"File prefix."
567
(let ((point (re-search-backward "[\"<>' \t\r\n]" nil t)))
568
(if point (1+ point))))
569
570
(defun ac-prefix-valid-file ()
571
"Existed (or to be existed) file prefix."
572
(let* ((line-beg (line-beginning-position))
573
(end (point))
574
(start (or (let ((point (re-search-backward "[\"<>'= \t\r\n]" line-beg t)))
575
(if point (1+ point)))
576
line-beg))
577
(file (buffer-substring start end)))
578
(if (and file (or (string-match "^/" file)
579
(and (setq file (and (string-match "^[^/]*/" file)
580
(match-string 0 file)))
581
(file-directory-p file))))
582
start)))
583
584
(defun ac-prefix-c-dot ()
585
"C-like languages dot(.) prefix."
586
(if (re-search-backward "\\.\\(\\(?:[a-zA-Z0-9][_a-zA-Z0-9]*\\)?\\)\\=" nil t)
587
(match-beginning 1)))
588
589
(defun ac-prefix-c-dot-ref ()
590
"C-like languages dot(.) and reference(->) prefix."
591
(if (re-search-backward "\\(?:\\.\\|->\\)\\(\\(?:[a-zA-Z0-9][_a-zA-Z0-9]*\\)?\\)\\=" nil t)
592
(match-beginning 1)))
593
594
(defun ac-define-prefix (name prefix)
595
"Define new prefix definition.
596
You can not use it in source definition like (prefix . `NAME')."
597
(push (cons name prefix) ac-prefix-definitions))
598
599
(defun ac-match-substring (prefix candidates)
600
(loop with regexp = (regexp-quote prefix)
601
for candidate in candidates
602
if (string-match regexp candidate)
603
collect candidate))
604
605
(defsubst ac-source-entity (source)
606
(if (symbolp source)
607
(symbol-value source)
608
source))
609
610
(defun ac-source-available-p (source)
611
(if (and (symbolp source)
612
(get source 'available))
613
(eq (get source 'available) t)
614
(let* ((src (ac-source-entity source))
615
(avail-pair (assq 'available src))
616
(avail-cond (cdr avail-pair))
617
(available (and (if avail-pair
618
(cond
619
((symbolp avail-cond)
620
(funcall avail-cond))
621
((listp avail-cond)
622
(eval avail-cond)))
623
t)
624
(loop for feature in (assoc-default 'depends src)
625
unless (require feature nil t) return nil
626
finally return t))))
627
(if (symbolp source)
628
(put source 'available (if available t 'no)))
629
available)))
630
631
(defun ac-compile-sources (sources)
632
"Compiled `SOURCES' into expanded sources style."
633
(loop for source in sources
634
if (ac-source-available-p source)
635
do
636
(setq source (ac-source-entity source))
637
(flet ((add-attribute (name value &optional append) (add-to-list 'source (cons name value) append)))
638
;; prefix
639
(let* ((prefix (assoc 'prefix source))
640
(real (assoc-default (cdr prefix) ac-prefix-definitions)))
641
(cond
642
(real
643
(add-attribute 'prefix real))
644
((null prefix)
645
(add-attribute 'prefix 'ac-prefix-default))))
646
;; match
647
(let ((match (assq 'match source)))
648
(cond
649
((eq (cdr match) 'substring)
650
(setcdr match 'ac-match-substring)))))
651
and collect source))
652
653
(defun ac-compiled-sources ()
654
(or ac-compiled-sources
655
(setq ac-compiled-sources
656
(ac-compile-sources ac-sources))))
657
658
(defsubst ac-menu-live-p ()
659
(popup-live-p ac-menu))
660
661
(defun ac-menu-create (point width height)
662
(setq ac-menu
663
(popup-create point width height
664
:around t
665
:face 'ac-candidate-face
666
:selection-face 'ac-selection-face
667
:symbol t
668
:scroll-bar t
669
:margin-left 1)))
670
671
(defun ac-menu-delete ()
672
(when ac-menu
673
(popup-delete ac-menu)
674
(setq ac-menu)))
675
676
(defsubst ac-inline-marker ()
677
(nth 0 ac-inline))
678
679
(defsubst ac-inline-overlay ()
680
(nth 1 ac-inline))
681
682
(defsubst ac-inline-live-p ()
683
(and ac-inline (ac-inline-overlay) t))
684
685
(defun ac-inline-show (point string)
686
(unless ac-inline
687
(setq ac-inline (list (make-marker) nil)))
688
(save-excursion
689
(let ((overlay (ac-inline-overlay))
690
(width 0)
691
(string-width (string-width string))
692
(length 0)
693
(original-string string))
694
;; Calculate string space to show completion
695
(goto-char point)
696
(let (c)
697
(while (and (not (eolp))
698
(< width string-width)
699
(setq c (char-after))
700
(not (eq c ?\t))) ; special case for tab
701
(incf width (char-width c))
702
(incf length)
703
(forward-char)))
704
705
;; Show completion
706
(goto-char point)
707
(cond
708
((= width 0)
709
(set-marker (ac-inline-marker) point)
710
(let ((buffer-undo-list t))
711
(insert " "))
712
(setq width 1
713
length 1))
714
((<= width string-width)
715
;; No space to show
716
;; Do nothing
717
)
718
((> width string-width)
719
;; Need to fill space
720
(setq string (concat string (make-string (- width string-width) ? )))))
721
(setq string (propertize string 'face 'ac-completion-face))
722
(if overlay
723
(progn
724
(move-overlay overlay point (+ point length))
725
(overlay-put overlay 'invisible nil))
726
(setq overlay (make-overlay point (+ point length)))
727
(setf (nth 1 ac-inline) overlay)
728
(overlay-put overlay 'priority 9999)
729
;; Help prefix-overlay in some cases
730
(overlay-put overlay 'keymap ac-current-map))
731
(overlay-put overlay 'display (substring string 0 1))
732
;; TODO no width but char
733
(overlay-put overlay 'after-string (substring string 1))
734
(overlay-put overlay 'string original-string))))
735
736
(defun ac-inline-delete ()
737
(when (ac-inline-live-p)
738
(ac-inline-hide)
739
(delete-overlay (ac-inline-overlay))
740
(setq ac-inline nil)))
741
742
(defun ac-inline-hide ()
743
(when (ac-inline-live-p)
744
(let ((overlay (ac-inline-overlay))
745
(marker (ac-inline-marker))
746
(buffer-undo-list t))
747
(when overlay
748
(when (marker-position marker)
749
(save-excursion
750
(goto-char marker)
751
(delete-char 1)
752
(set-marker marker nil)))
753
(move-overlay overlay (point-min) (point-min))
754
(overlay-put overlay 'invisible t)
755
(overlay-put overlay 'display nil)
756
(overlay-put overlay 'after-string nil)))))
757
758
(defun ac-inline-update ()
759
(if (and ac-completing ac-prefix (stringp ac-common-part))
760
(let ((common-part-length (length ac-common-part))
761
(prefix-length (length ac-prefix)))
762
(if (> common-part-length prefix-length)
763
(progn
764
(ac-inline-hide)
765
(ac-inline-show (point) (substring ac-common-part prefix-length)))
766
(ac-inline-delete)))
767
(ac-inline-delete)))
768
769
(defun ac-put-prefix-overlay ()
770
(unless ac-prefix-overlay
771
(let (newline)
772
;; Insert newline to make sure that cursor always on the overlay
773
(when (and (eq ac-point (point-max))
774
(eq ac-point (point)))
775
(popup-save-buffer-state
776
(insert "\n"))
777
(setq newline t))
778
(setq ac-prefix-overlay (make-overlay ac-point (1+ (point)) nil t t))
779
(overlay-put ac-prefix-overlay 'priority 9999)
780
(overlay-put ac-prefix-overlay 'keymap (make-sparse-keymap))
781
(overlay-put ac-prefix-overlay 'newline newline))))
782
783
(defun ac-remove-prefix-overlay ()
784
(when ac-prefix-overlay
785
(when (overlay-get ac-prefix-overlay 'newline)
786
;; Remove inserted newline
787
(popup-save-buffer-state
788
(goto-char (point-max))
789
(if (eq (char-before) ?\n)
790
(delete-char -1))))
791
(delete-overlay ac-prefix-overlay)))
792
793
(defun ac-activate-completing-map ()
794
(if (and ac-show-menu ac-use-menu-map)
795
(set-keymap-parent ac-current-map ac-menu-map))
796
(when (and ac-use-overriding-local-map
797
(null overriding-terminal-local-map))
798
(setq overriding-terminal-local-map ac-current-map))
799
(when ac-prefix-overlay
800
(set-keymap-parent (overlay-get ac-prefix-overlay 'keymap) ac-current-map)))
801
802
(defun ac-deactivate-completing-map ()
803
(set-keymap-parent ac-current-map ac-completing-map)
804
(when (and ac-use-overriding-local-map
805
(eq overriding-terminal-local-map ac-current-map))
806
(setq overriding-terminal-local-map nil))
807
(when ac-prefix-overlay
808
(set-keymap-parent (overlay-get ac-prefix-overlay 'keymap) nil)))
809
810
(defsubst ac-selected-candidate ()
811
(if ac-menu
812
(popup-selected-item ac-menu)))
813
814
(defun ac-prefix (requires ignore-list)
815
(loop with current = (point)
816
with point
817
with prefix-def
818
with sources
819
for source in (ac-compiled-sources)
820
for prefix = (assoc-default 'prefix source)
821
for req = (or (assoc-default 'requires source) requires 1)
822
823
if (null prefix-def)
824
do
825
(unless (member prefix ignore-list)
826
(save-excursion
827
(setq point (cond
828
((symbolp prefix)
829
(funcall prefix))
830
((stringp prefix)
831
(and (re-search-backward (concat prefix "\\=") nil t)
832
(or (match-beginning 1) (match-beginning 0))))
833
((stringp (car-safe prefix))
834
(let ((regexp (nth 0 prefix))
835
(end (nth 1 prefix))
836
(group (nth 2 prefix)))
837
(and (re-search-backward (concat regexp "\\=") nil t)
838
(funcall (if end 'match-end 'match-beginning)
839
(or group 0)))))
840
(t
841
(eval prefix))))
842
(if (and point
843
(integerp req)
844
(< (- current point) req))
845
(setq point nil))
846
(if point
847
(setq prefix-def prefix))))
848
849
if (equal prefix prefix-def) do (push source sources)
850
851
finally return
852
(and point (list prefix-def point (nreverse sources)))))
853
854
(defun ac-init ()
855
"Initialize current sources to start completion."
856
(setq ac-candidates-cache nil)
857
(loop for source in ac-current-sources
858
for function = (assoc-default 'init source)
859
if function do
860
(save-excursion
861
(cond
862
((functionp function)
863
(funcall function))
864
(t
865
(eval function))))))
866
867
(defun ac-candidates-1 (source)
868
(let* ((do-cache (assq 'cache source))
869
(function (assoc-default 'candidates source))
870
(action (assoc-default 'action source))
871
(document (assoc-default 'document source))
872
(symbol (assoc-default 'symbol source))
873
(ac-limit (or (assoc-default 'limit source) ac-limit))
874
(face (or (assoc-default 'face source) (assoc-default 'candidate-face source)))
875
(selection-face (assoc-default 'selection-face source))
876
(cache (and do-cache (assq source ac-candidates-cache)))
877
(candidates (cdr cache)))
878
(unless cache
879
(setq candidates (save-excursion
880
(cond
881
((functionp function)
882
(funcall function))
883
(t
884
(eval function)))))
885
;; Convert (name value) format candidates into name with text properties.
886
(setq candidates (mapcar (lambda (candidate)
887
(if (consp candidate)
888
(propertize (car candidate) 'value (cdr candidate))
889
candidate))
890
candidates))
891
(when do-cache
892
(push (cons source candidates) ac-candidates-cache)))
893
(setq candidates (funcall (or (assoc-default 'match source)
894
ac-match-function)
895
ac-prefix candidates))
896
;; Remove extra items regarding to ac-limit
897
(if (and (integerp ac-limit) (> ac-limit 1) (> (length candidates) ac-limit))
898
(setcdr (nthcdr (1- ac-limit) candidates) nil))
899
;; Put candidate properties
900
(setq candidates (mapcar (lambda (candidate)
901
(popup-item-propertize candidate
902
'action action
903
'symbol symbol
904
'document document
905
'popup-face face
906
'selection-face selection-face))
907
candidates))
908
candidates))
909
910
(defun ac-candidates ()
911
"Produce candidates for current sources."
912
(loop with completion-ignore-case = (or (eq ac-ignore-case t)
913
(and (eq ac-ignore-case 'smart)
914
(let ((case-fold-search nil)) (not (string-match "[[:upper:]]" ac-prefix)))))
915
with case-fold-search = completion-ignore-case
916
with prefix-len = (length ac-prefix)
917
for source in ac-current-sources
918
append (ac-candidates-1 source) into candidates
919
finally return
920
(progn
921
(delete-dups candidates)
922
(if (and ac-use-comphist ac-comphist)
923
(if ac-show-menu
924
(let* ((pair (ac-comphist-sort ac-comphist candidates prefix-len ac-comphist-threshold))
925
(n (car pair))
926
(result (cdr pair))
927
(cons (if (> n 0) (nthcdr (1- n) result)))
928
(cdr (cdr cons)))
929
(if cons (setcdr cons nil))
930
(setq ac-common-part (try-completion ac-prefix result))
931
(setq ac-whole-common-part (try-completion ac-prefix candidates))
932
(if cons (setcdr cons cdr))
933
result)
934
(setq candidates (ac-comphist-sort ac-comphist candidates prefix-len))
935
(setq ac-common-part (if candidates (popup-x-to-string (car candidates))))
936
(setq ac-whole-common-part (try-completion ac-prefix candidates))
937
candidates)
938
(setq ac-common-part (try-completion ac-prefix candidates))
939
(setq ac-whole-common-part ac-common-part)
940
candidates))))
941
942
(defun ac-update-candidates (cursor scroll-top)
943
"Update candidates of menu to `ac-candidates' and redraw it."
944
(setf (popup-cursor ac-menu) cursor
945
(popup-scroll-top ac-menu) scroll-top)
946
(setq ac-dwim-enable (= (length ac-candidates) 1))
947
(if ac-candidates
948
(progn
949
(setq ac-completing t)
950
(ac-activate-completing-map))
951
(setq ac-completing nil)
952
(ac-deactivate-completing-map))
953
(ac-inline-update)
954
(popup-set-list ac-menu ac-candidates)
955
(if (and (not ac-fuzzy-enable)
956
(<= (length ac-candidates) 1))
957
(popup-hide ac-menu)
958
(if ac-show-menu
959
(popup-draw ac-menu))))
960
961
(defun ac-reposition ()
962
"Force to redraw candidate menu with current `ac-candidates'."
963
(let ((cursor (popup-cursor ac-menu))
964
(scroll-top (popup-scroll-top ac-menu)))
965
(ac-menu-delete)
966
(ac-menu-create ac-point (popup-preferred-width ac-candidates) (popup-height ac-menu))
967
(ac-update-candidates cursor scroll-top)))
968
969
(defun ac-cleanup ()
970
"Cleanup auto completion."
971
(if ac-cursor-color
972
(set-cursor-color ac-cursor-color))
973
(when (and ac-use-comphist ac-comphist)
974
(when (and (null ac-selected-candidate)
975
(member ac-prefix ac-candidates))
976
;; Assume candidate is selected by just typing
977
(setq ac-selected-candidate ac-prefix)
978
(setq ac-last-point ac-point))
979
(when ac-selected-candidate
980
(ac-comphist-add ac-comphist
981
ac-selected-candidate
982
(if ac-last-point
983
(- ac-last-point ac-point)
984
(length ac-prefix)))))
985
(ac-deactivate-completing-map)
986
(ac-remove-prefix-overlay)
987
(ac-remove-quick-help)
988
(ac-inline-delete)
989
(ac-menu-delete)
990
(ac-cancel-timer)
991
(ac-cancel-show-menu-timer)
992
(ac-cancel-quick-help-timer)
993
(setq ac-cursor-color nil
994
ac-inline nil
995
ac-show-menu nil
996
ac-menu nil
997
ac-completing nil
998
ac-point nil
999
ac-last-point nil
1000
ac-prefix nil
1001
ac-prefix-overlay nil
1002
ac-selected-candidate nil
1003
ac-common-part nil
1004
ac-whole-common-part nil
1005
ac-triggered nil
1006
ac-limit nil
1007
ac-candidates nil
1008
ac-candidates-cache nil
1009
ac-fuzzy-enable nil
1010
ac-dwim-enable nil
1011
ac-compiled-sources nil
1012
ac-current-sources nil
1013
ac-current-prefix-def nil
1014
ac-ignoring-prefix-def nil))
1015
1016
(defsubst ac-abort ()
1017
"Abort completion."
1018
(ac-cleanup))
1019
1020
(defun ac-expand-string (string &optional remove-undo-boundary)
1021
"Expand `STRING' into the buffer and update `ac-prefix' to `STRING'.
1022
This function records deletion and insertion sequences by `undo-boundary'.
1023
If `remove-undo-boundary' is non-nil, this function also removes `undo-boundary'
1024
that have been made before in this function."
1025
(when (not (equal string (buffer-substring ac-point (point))))
1026
(undo-boundary)
1027
;; We can't use primitive-undo since it undoes by
1028
;; groups, divided by boundaries.
1029
;; We don't want boundary between deletion and insertion.
1030
;; So do it manually.
1031
;; Delete region silently for undo:
1032
(if remove-undo-boundary
1033
(progn
1034
(let (buffer-undo-list)
1035
(save-excursion
1036
(delete-region ac-point (point))))
1037
(setq buffer-undo-list
1038
(nthcdr 2 buffer-undo-list)))
1039
(delete-region ac-point (point)))
1040
(insert string)
1041
;; Sometimes, possible when omni-completion used, (insert) added
1042
;; to buffer-undo-list strange record about position changes.
1043
;; Delete it here:
1044
(when (and remove-undo-boundary
1045
(integerp (cadr buffer-undo-list)))
1046
(setcdr buffer-undo-list (nthcdr 2 buffer-undo-list)))
1047
(undo-boundary)
1048
(setq ac-selected-candidate string)
1049
(setq ac-prefix string)))
1050
1051
(defun ac-set-trigger-key (key)
1052
"Set `ac-trigger-key' to `KEY'. It is recommemded to use this function instead of calling `setq'."
1053
;; Remove old mapping
1054
(when ac-trigger-key
1055
(define-key ac-mode-map (read-kbd-macro ac-trigger-key) nil))
1056
1057
;; Make new mapping
1058
(setq ac-trigger-key key)
1059
(when key
1060
(define-key ac-mode-map (read-kbd-macro key) 'ac-trigger-key-command)))
1061
1062
(defun ac-set-timer ()
1063
(unless ac-timer
1064
(setq ac-timer (run-with-idle-timer ac-delay ac-delay 'ac-update-greedy))))
1065
1066
(defun ac-cancel-timer ()
1067
(when (timerp ac-timer)
1068
(cancel-timer ac-timer)
1069
(setq ac-timer nil)))
1070
1071
(defun ac-update (&optional force)
1072
(when (and auto-complete-mode
1073
ac-prefix
1074
(or ac-triggered
1075
force)
1076
(not isearch-mode))
1077
(ac-put-prefix-overlay)
1078
(setq ac-candidates (ac-candidates))
1079
(let ((preferred-width (popup-preferred-width ac-candidates)))
1080
;; Reposition if needed
1081
(when (or (null ac-menu)
1082
(>= (popup-width ac-menu) preferred-width)
1083
(<= (popup-width ac-menu) (- preferred-width 10))
1084
(and (> (popup-direction ac-menu) 0)
1085
(ac-menu-at-wrapper-line-p)))
1086
(ac-inline-hide) ; Hide overlay to calculate correct column
1087
(ac-menu-delete)
1088
(ac-menu-create ac-point preferred-width ac-menu-height)))
1089
(ac-update-candidates 0 0)
1090
t))
1091
1092
(defun ac-update-greedy (&optional force)
1093
(let (result)
1094
(while (when (and (setq result (ac-update force))
1095
(null ac-candidates))
1096
(add-to-list 'ac-ignoring-prefix-def ac-current-prefix-def)
1097
(ac-start :force-init t)
1098
ac-current-prefix-def))
1099
result))
1100
1101
(defun ac-set-show-menu-timer ()
1102
(when (and (or (integerp ac-auto-show-menu) (floatp ac-auto-show-menu))
1103
(null ac-show-menu-timer))
1104
(setq ac-show-menu-timer (run-with-idle-timer ac-auto-show-menu ac-auto-show-menu 'ac-show-menu))))
1105
1106
(defun ac-cancel-show-menu-timer ()
1107
(when (timerp ac-show-menu-timer)
1108
(cancel-timer ac-show-menu-timer)
1109
(setq ac-show-menu-timer nil)))
1110
1111
(defun ac-show-menu ()
1112
(when (not (eq ac-show-menu t))
1113
(setq ac-show-menu t)
1114
(ac-inline-hide)
1115
(ac-remove-quick-help)
1116
(ac-update t)))
1117
1118
(defun ac-help (&optional persist)
1119
(interactive "P")
1120
(when ac-menu
1121
(popup-menu-show-help ac-menu persist)))
1122
1123
(defun ac-persist-help ()
1124
(interactive)
1125
(ac-help t))
1126
1127
(defun ac-last-help (&optional persist)
1128
(interactive "P")
1129
(when ac-last-completion
1130
(popup-item-show-help (cdr ac-last-completion) persist)))
1131
1132
(defun ac-last-persist-help ()
1133
(interactive)
1134
(ac-last-help t))
1135
1136
(defun ac-set-quick-help-timer ()
1137
(when (and ac-use-quick-help
1138
(null ac-quick-help-timer))
1139
(setq ac-quick-help-timer (run-with-idle-timer ac-quick-help-delay ac-quick-help-delay 'ac-quick-help))))
1140
1141
(defun ac-cancel-quick-help-timer ()
1142
(when (timerp ac-quick-help-timer)
1143
(cancel-timer ac-quick-help-timer)
1144
(setq ac-quick-help-timer nil)))
1145
1146
(defun ac-pos-tip-show-quick-help (menu &optional item &rest args)
1147
(let* ((point (plist-get args :point))
1148
(around nil)
1149
(parent-offset (popup-offset menu))
1150
(doc (popup-menu-documentation menu item)))
1151
(when (stringp doc)
1152
(if (popup-hidden-p menu)
1153
(setq around t)
1154
(setq point nil))
1155
(with-no-warnings
1156
(pos-tip-show doc
1157
'popup-tip-face
1158
(or point
1159
(and menu
1160
(popup-child-point menu parent-offset))
1161
(point))
1162
nil 0
1163
popup-tip-max-width
1164
nil nil
1165
(and (not around) 0))
1166
(unless (plist-get args :nowait)
1167
(clear-this-command-keys)
1168
(unwind-protect
1169
(push (read-event (plist-get args :prompt)) unread-command-events)
1170
(pos-tip-hide))
1171
t)))))
1172
1173
(defun ac-quick-help (&optional force)
1174
(interactive)
1175
(when (and (or force (null this-command))
1176
(ac-menu-live-p)
1177
(null ac-quick-help))
1178
(setq ac-quick-help
1179
(funcall (if (and ac-quick-help-prefer-x
1180
(eq window-system 'x)
1181
(featurep 'pos-tip))
1182
'ac-pos-tip-show-quick-help
1183
'popup-menu-show-quick-help)
1184
ac-menu nil
1185
:point ac-point
1186
:height ac-quick-help-height
1187
:nowait t))))
1188
1189
(defun ac-remove-quick-help ()
1190
(when ac-quick-help
1191
(popup-delete ac-quick-help)
1192
(setq ac-quick-help nil)))
1193
1194
(defun ac-last-quick-help ()
1195
(interactive)
1196
(when (and ac-last-completion
1197
(eq (marker-buffer (car ac-last-completion))
1198
(current-buffer)))
1199
(let ((doc (popup-item-documentation (cdr ac-last-completion)))
1200
(point (marker-position (car ac-last-completion))))
1201
(when (stringp doc)
1202
(if (and ac-quick-help-prefer-x
1203
(eq window-system 'x)
1204
(featurep 'pos-tip))
1205
(with-no-warnings (pos-tip-show doc nil point nil 0))
1206
(popup-tip doc
1207
:point point
1208
:around t
1209
:scroll-bar t
1210
:margin t))))))
1211
1212
(defmacro ac-define-quick-help-command (name arglist &rest body)
1213
(declare (indent 2))
1214
`(progn
1215
(defun ,name ,arglist ,@body)
1216
(put ',name 'ac-quick-help-command t)))
1217
1218
(ac-define-quick-help-command ac-quick-help-scroll-down ()
1219
(interactive)
1220
(when ac-quick-help
1221
(popup-scroll-down ac-quick-help)))
1222
1223
(ac-define-quick-help-command ac-quick-help-scroll-up ()
1224
(interactive)
1225
(when ac-quick-help
1226
(popup-scroll-up ac-quick-help)))
1227
1228
1229
1230
;;;; Auto completion isearch
1231
1232
(defun ac-isearch-callback (list)
1233
(setq ac-dwim-enable (eq (length list) 1)))
1234
1235
(defun ac-isearch ()
1236
(interactive)
1237
(when (ac-menu-live-p)
1238
(ac-cancel-show-menu-timer)
1239
(ac-cancel-quick-help-timer)
1240
(ac-show-menu)
1241
(popup-isearch ac-menu :callback 'ac-isearch-callback)))
1242
1243
1244
1245
;;;; Auto completion commands
1246
1247
(defun auto-complete (&optional sources)
1248
"Start auto-completion at current point."
1249
(interactive)
1250
(let ((menu-live (ac-menu-live-p))
1251
(inline-live (ac-inline-live-p)))
1252
(ac-abort)
1253
(let ((ac-sources (or sources ac-sources)))
1254
(if (or ac-show-menu-immediately-on-auto-complete
1255
inline-live)
1256
(setq ac-show-menu t))
1257
(ac-start))
1258
(when (ac-update-greedy t)
1259
;; TODO Not to cause inline completion to be disrupted.
1260
(if (ac-inline-live-p)
1261
(ac-inline-hide))
1262
;; Not to expand when it is first time to complete
1263
(when (and (or (and (not ac-expand-on-auto-complete)
1264
(> (length ac-candidates) 1)
1265
(not menu-live))
1266
(not (let ((ac-common-part ac-whole-common-part))
1267
(ac-expand-common))))
1268
ac-use-fuzzy
1269
(null ac-candidates))
1270
(ac-fuzzy-complete)))))
1271
1272
(defun ac-fuzzy-complete ()
1273
"Start fuzzy completion at current point."
1274
(interactive)
1275
(when (require 'fuzzy nil)
1276
(unless (ac-menu-live-p)
1277
(ac-start))
1278
(let ((ac-match-function 'fuzzy-all-completions))
1279
(unless ac-cursor-color
1280
(setq ac-cursor-color (frame-parameter (selected-frame) 'cursor-color)))
1281
(if ac-fuzzy-cursor-color
1282
(set-cursor-color ac-fuzzy-cursor-color))
1283
(setq ac-show-menu t)
1284
(setq ac-fuzzy-enable t)
1285
(setq ac-triggered nil)
1286
(ac-update t)))
1287
t)
1288
1289
(defun ac-next ()
1290
"Select next candidate."
1291
(interactive)
1292
(when (ac-menu-live-p)
1293
(popup-next ac-menu)
1294
(setq ac-show-menu t)
1295
(if (eq this-command 'ac-next)
1296
(setq ac-dwim-enable t))))
1297
1298
(defun ac-previous ()
1299
"Select previous candidate."
1300
(interactive)
1301
(when (ac-menu-live-p)
1302
(popup-previous ac-menu)
1303
(setq ac-show-menu t)
1304
(if (eq this-command 'ac-previous)
1305
(setq ac-dwim-enable t))))
1306
1307
(defun ac-expand ()
1308
"Try expand, and if expanded twice, select next candidate."
1309
(interactive)
1310
(unless (ac-expand-common)
1311
(let ((string (ac-selected-candidate)))
1312
(when string
1313
(when (equal ac-prefix string)
1314
(ac-next)
1315
(setq string (ac-selected-candidate)))
1316
(ac-expand-string string (eq last-command this-command))
1317
;; Do reposition if menu at long line
1318
(if (and (> (popup-direction ac-menu) 0)
1319
(ac-menu-at-wrapper-line-p))
1320
(ac-reposition))
1321
(setq ac-show-menu t)
1322
string))))
1323
1324
(defun ac-expand-common ()
1325
"Try to expand meaningful common part."
1326
(interactive)
1327
(if (and ac-dwim ac-dwim-enable)
1328
(ac-complete)
1329
(when (and (ac-inline-live-p)
1330
ac-common-part)
1331
(ac-inline-hide)
1332
(ac-expand-string ac-common-part (eq last-command this-command))
1333
(setq ac-common-part nil)
1334
t)))
1335
1336
(defun ac-complete ()
1337
"Try complete."
1338
(interactive)
1339
(let* ((candidate (ac-selected-candidate))
1340
(action (popup-item-property candidate 'action))
1341
(fallback nil))
1342
(when candidate
1343
(unless (ac-expand-string candidate)
1344
(setq fallback t))
1345
;; Remember to show help later
1346
(when (and ac-point candidate)
1347
(unless ac-last-completion
1348
(setq ac-last-completion (cons (make-marker) nil)))
1349
(set-marker (car ac-last-completion) ac-point ac-buffer)
1350
(setcdr ac-last-completion candidate)))
1351
(ac-abort)
1352
(cond
1353
(action
1354
(funcall action))
1355
(fallback
1356
(ac-fallback-command)))
1357
candidate))
1358
1359
(defun* ac-start (&key
1360
requires
1361
force-init)
1362
"Start completion."
1363
(interactive)
1364
(if (not auto-complete-mode)
1365
(message "auto-complete-mode is not enabled")
1366
(let* ((info (ac-prefix requires ac-ignoring-prefix-def))
1367
(prefix-def (nth 0 info))
1368
(point (nth 1 info))
1369
(sources (nth 2 info))
1370
prefix
1371
(init (or force-init (not (eq ac-point point)))))
1372
(if (or (null point)
1373
(member (setq prefix (buffer-substring-no-properties point (point)))
1374
ac-ignores))
1375
(prog1 nil
1376
(ac-abort))
1377
(unless ac-cursor-color
1378
(setq ac-cursor-color (frame-parameter (selected-frame) 'cursor-color)))
1379
(setq ac-show-menu (or ac-show-menu (if (eq ac-auto-show-menu t) t))
1380
ac-current-sources sources
1381
ac-buffer (current-buffer)
1382
ac-point point
1383
ac-prefix prefix
1384
ac-limit ac-candidate-limit
1385
ac-triggered t
1386
ac-current-prefix-def prefix-def)
1387
(when (or init (null ac-prefix-overlay))
1388
(ac-init))
1389
(ac-set-timer)
1390
(ac-set-show-menu-timer)
1391
(ac-set-quick-help-timer)
1392
(ac-put-prefix-overlay)))))
1393
1394
(defun ac-stop ()
1395
"Stop completiong."
1396
(interactive)
1397
(setq ac-selected-candidate nil)
1398
(ac-abort))
1399
1400
(defun ac-trigger-key-command (&optional force)
1401
(interactive "P")
1402
(if (or force (ac-trigger-command-p last-command))
1403
(auto-complete)
1404
(ac-fallback-command 'ac-trigger-key-command)))
1405
1406
1407
1408
;;;; Basic cache facility
1409
1410
(defvar ac-clear-variables-every-minute-timer nil)
1411
(defvar ac-clear-variables-after-save nil)
1412
(defvar ac-clear-variables-every-minute nil)
1413
(defvar ac-minutes-counter 0)
1414
1415
(defun ac-clear-variable-after-save (variable &optional pred)
1416
(add-to-list 'ac-clear-variables-after-save (cons variable pred)))
1417
1418
(defun ac-clear-variables-after-save ()
1419
(dolist (pair ac-clear-variables-after-save)
1420
(if (or (null (cdr pair))
1421
(funcall (cdr pair)))
1422
(set (car pair) nil))))
1423
1424
(defun ac-clear-variable-every-minutes (variable minutes)
1425
(add-to-list 'ac-clear-variables-every-minute (cons variable minutes)))
1426
1427
(defun ac-clear-variable-every-minute (variable)
1428
(ac-clear-variable-every-minutes variable 1))
1429
1430
(defun ac-clear-variable-every-10-minutes (variable)
1431
(ac-clear-variable-every-minutes variable 10))
1432
1433
(defun ac-clear-variables-every-minute ()
1434
(incf ac-minutes-counter)
1435
(dolist (pair ac-clear-variables-every-minute)
1436
(if (eq (% ac-minutes-counter (cdr pair)) 0)
1437
(set (car pair) nil))))
1438
1439
1440
1441
;;;; Auto complete mode
1442
1443
(defun ac-cursor-on-diable-face-p (&optional point)
1444
(memq (get-text-property (or point (point)) 'face) ac-disable-faces))
1445
1446
(defun ac-trigger-command-p (command)
1447
"Return non-nil if `COMMAND' is a trigger command."
1448
(and (symbolp command)
1449
(or (memq command ac-trigger-commands)
1450
(string-match "self-insert-command" (symbol-name command))
1451
(string-match "electric" (symbol-name command)))))
1452
1453
(defun ac-fallback-command (&optional except-command)
1454
(let* ((auto-complete-mode nil)
1455
(keys (this-command-keys-vector))
1456
(command (if keys (key-binding keys))))
1457
(when (and (commandp command)
1458
(not (eq command except-command)))
1459
(setq this-command command)
1460
(call-interactively command))))
1461
1462
(defun ac-compatible-package-command-p (command)
1463
"Return non-nil if `COMMAND' is compatible with auto-complete."
1464
(and (symbolp command)
1465
(string-match ac-compatible-packages-regexp (symbol-name command))))
1466
1467
(defun ac-handle-pre-command ()
1468
(condition-case var
1469
(if (or (setq ac-triggered (and (not ac-fuzzy-enable) ; ignore key storkes in fuzzy mode
1470
(or (eq this-command 'auto-complete) ; special case
1471
(ac-trigger-command-p this-command)
1472
(and ac-completing
1473
(memq this-command ac-trigger-commands-on-completing)))
1474
(not (ac-cursor-on-diable-face-p))))
1475
(ac-compatible-package-command-p this-command))
1476
(progn
1477
(if (or (not (symbolp this-command))
1478
(not (get this-command 'ac-quick-help-command)))
1479
(ac-remove-quick-help))
1480
;; Not to cause inline completion to be disrupted.
1481
(ac-inline-hide))
1482
(ac-abort))
1483
(error (ac-error var))))
1484
1485
(defun ac-handle-post-command ()
1486
(condition-case var
1487
(when (and ac-triggered
1488
(or ac-auto-start
1489
ac-completing)
1490
(not isearch-mode))
1491
(setq ac-last-point (point))
1492
(ac-start :requires (unless ac-completing ac-auto-start))
1493
(ac-inline-update))
1494
(error (ac-error var))))
1495
1496
(defun ac-setup ()
1497
(if ac-trigger-key
1498
(ac-set-trigger-key ac-trigger-key))
1499
(if ac-use-comphist
1500
(ac-comphist-init))
1501
(unless ac-clear-variables-every-minute-timer
1502
(setq ac-clear-variables-every-minute-timer (run-with-timer 60 60 'ac-clear-variables-every-minute)))
1503
(if ac-stop-flymake-on-completing
1504
(defadvice flymake-on-timer-event (around ac-flymake-stop-advice activate)
1505
(unless ac-completing
1506
ad-do-it))
1507
(ad-disable-advice 'flymake-on-timer-event 'around 'ac-flymake-stop-advice)))
1508
1509
(define-minor-mode auto-complete-mode
1510
"AutoComplete mode"
1511
:lighter " AC"
1512
:keymap ac-mode-map
1513
:group 'auto-complete
1514
(if auto-complete-mode
1515
(progn
1516
(ac-setup)
1517
(add-hook 'pre-command-hook 'ac-handle-pre-command nil t)
1518
(add-hook 'post-command-hook 'ac-handle-post-command nil t)
1519
(add-hook 'after-save-hook 'ac-clear-variables-after-save nil t)
1520
(run-hooks 'auto-complete-mode-hook))
1521
(remove-hook 'pre-command-hook 'ac-handle-pre-command t)
1522
(remove-hook 'post-command-hook 'ac-handle-post-command t)
1523
(remove-hook 'after-save-hook 'ac-clear-variables-after-save t)
1524
(ac-abort)))
1525
1526
(defun auto-complete-mode-maybe ()
1527
"What buffer `auto-complete-mode' prefers."
1528
(if (and (not (minibufferp (current-buffer)))
1529
(memq major-mode ac-modes))
1530
(auto-complete-mode 1)))
1531
1532
(define-global-minor-mode global-auto-complete-mode
1533
auto-complete-mode auto-complete-mode-maybe
1534
:group 'auto-complete)
1535
1536
1537
1538
;;;; Compatibilities with other extensions
1539
1540
(defun ac-flyspell-workaround ()
1541
"Flyspell uses `sit-for' for delaying its process. Unfortunatelly,
1542
it stops auto completion which is trigger with `run-with-idle-timer'.
1543
This workaround avoid flyspell processes when auto completion is being started."
1544
(interactive)
1545
(defadvice flyspell-post-command-hook (around ac-flyspell-workaround activate)
1546
(unless ac-triggered
1547
ad-do-it)))
1548
1549
1550
1551
;;;; Standard sources
1552
1553
(defmacro ac-define-source (name source)
1554
"Source definition macro. It defines a complete command also."
1555
(declare (indent 1))
1556
`(progn
1557
(defvar ,(intern (format "ac-source-%s" name))
1558
,source)
1559
(defun ,(intern (format "ac-complete-%s" name)) ()
1560
(interactive)
1561
(auto-complete '(,(intern (format "ac-source-%s" name)))))))
1562
1563
;; Words in buffer source
1564
(defvar ac-word-index nil)
1565
1566
(defun ac-candidate-words-in-buffer (point prefix limit)
1567
(let ((i 0)
1568
candidate
1569
candidates
1570
(regexp (concat "\\_<" (regexp-quote prefix) "\\(\\sw\\|\\s_\\)+\\_>")))
1571
(save-excursion
1572
;; Search backward
1573
(goto-char point)
1574
(while (and (or (not (integerp limit)) (< i limit))
1575
(re-search-backward regexp nil t))
1576
(setq candidate (match-string-no-properties 0))
1577
(unless (member candidate candidates)
1578
(push candidate candidates)
1579
(incf i)))
1580
;; Search backward
1581
(goto-char (+ point (length prefix)))
1582
(while (and (or (not (integerp limit)) (< i limit))
1583
(re-search-forward regexp nil t))
1584
(setq candidate (match-string-no-properties 0))
1585
(unless (member candidate candidates)
1586
(push candidate candidates)
1587
(incf i)))
1588
(nreverse candidates))))
1589
1590
(defun ac-incremental-update-word-index ()
1591
(unless (local-variable-p 'ac-word-index)
1592
(make-local-variable 'ac-word-index))
1593
(if (null ac-word-index)
1594
(setq ac-word-index (cons nil nil)))
1595
;; Mark incomplete
1596
(if (car ac-word-index)
1597
(setcar ac-word-index nil))
1598
(let ((index (cdr ac-word-index))
1599
(words (ac-candidate-words-in-buffer ac-point ac-prefix (or (and (integerp ac-limit) ac-limit) 10))))
1600
(dolist (word words)
1601
(unless (member word index)
1602
(push word index)
1603
(setcdr ac-word-index index)))))
1604
1605
(defun ac-update-word-index-1 ()
1606
(unless (local-variable-p 'ac-word-index)
1607
(make-local-variable 'ac-word-index))
1608
(when (and (not (car ac-word-index))
1609
(< (buffer-size) 1048576))
1610
;; Complete index
1611
(setq ac-word-index
1612
(cons t
1613
(split-string (buffer-substring-no-properties (point-min) (point-max))
1614
"\\(?:^\\|\\_>\\).*?\\(?:\\_<\\|$\\)")))))
1615
1616
(defun ac-update-word-index ()
1617
(dolist (buffer (buffer-list))
1618
(when (or ac-fuzzy-enable
1619
(not (eq buffer (current-buffer))))
1620
(with-current-buffer buffer
1621
(ac-update-word-index-1)))))
1622
1623
(defun ac-word-candidates (&optional buffer-pred)
1624
(loop initially (unless ac-fuzzy-enable (ac-incremental-update-word-index))
1625
for buffer in (buffer-list)
1626
if (and (or (not (integerp ac-limit)) (< (length candidates) ac-limit))
1627
(if buffer-pred (funcall buffer-pred buffer) t))
1628
append (funcall ac-match-function
1629
ac-prefix
1630
(and (local-variable-p 'ac-word-index buffer)
1631
(cdr (buffer-local-value 'ac-word-index buffer))))
1632
into candidates
1633
finally return candidates))
1634
1635
(ac-define-source words-in-buffer
1636
'((candidates . ac-word-candidates)))
1637
1638
(ac-define-source words-in-all-buffer
1639
'((init . ac-update-word-index)
1640
(candidates . ac-word-candidates)))
1641
1642
(ac-define-source words-in-same-mode-buffers
1643
'((init . ac-update-word-index)
1644
(candidates . (ac-word-candidates
1645
(lambda (buffer)
1646
(derived-mode-p (buffer-local-value 'major-mode buffer)))))))
1647
1648
;; Lisp symbols source
1649
(defvar ac-symbols-cache nil)
1650
(ac-clear-variable-every-10-minutes 'ac-symbols-cache)
1651
1652
(defun ac-symbol-file (symbol type)
1653
(if (fboundp 'find-lisp-object-file-name)
1654
(find-lisp-object-file-name symbol type)
1655
(let ((file-name (with-no-warnings
1656
(describe-simplify-lib-file-name
1657
(symbol-file symbol type)))))
1658
(when (equal file-name "loaddefs.el")
1659
;; Find the real def site of the preloaded object.
1660
(let ((location (condition-case nil
1661
(if (eq type 'defun)
1662
(find-function-search-for-symbol symbol nil
1663
"loaddefs.el")
1664
(find-variable-noselect symbol file-name))
1665
(error nil))))
1666
(when location
1667
(with-current-buffer (car location)
1668
(when (cdr location)
1669
(goto-char (cdr location)))
1670
(when (re-search-backward
1671
"^;;; Generated autoloads from \\(.*\\)" nil t)
1672
(setq file-name (match-string 1)))))))
1673
(if (and (null file-name)
1674
(or (eq type 'defun)
1675
(integerp (get symbol 'variable-documentation))))
1676
;; It's a object not defined in Elisp but in C.
1677
(if (get-buffer " *DOC*")
1678
(if (eq type 'defun)
1679
(help-C-file-name (symbol-function symbol) 'subr)
1680
(help-C-file-name symbol 'var))
1681
'C-source)
1682
file-name))))
1683
1684
(defun ac-symbol-documentation (symbol)
1685
(if (stringp symbol)
1686
(setq symbol (intern-soft symbol)))
1687
(ignore-errors
1688
(with-temp-buffer
1689
(let ((standard-output (current-buffer)))
1690
(prin1 symbol)
1691
(princ " is ")
1692
(cond
1693
((fboundp symbol)
1694
(let ((help-xref-following t))
1695
(describe-function-1 symbol))
1696
(buffer-string))
1697
((boundp symbol)
1698
(let ((file-name (ac-symbol-file symbol 'defvar)))
1699
(princ "a variable")
1700
(when file-name
1701
(princ " defined in `")
1702
(princ (if (eq file-name 'C-source)
1703
"C source code"
1704
(file-name-nondirectory file-name))))
1705
(princ "'.\n\n")
1706
(princ (or (documentation-property symbol 'variable-documentation t)
1707
"Not documented."))
1708
(buffer-string)))
1709
((facep symbol)
1710
(let ((file-name (ac-symbol-file symbol 'defface)))
1711
(princ "a face")
1712
(when file-name
1713
(princ " defined in `")
1714
(princ (if (eq file-name 'C-source)
1715
"C source code"
1716
(file-name-nondirectory file-name))))
1717
(princ "'.\n\n")
1718
(princ (or (documentation-property symbol 'face-documentation t)
1719
"Not documented."))
1720
(buffer-string)))
1721
(t
1722
(let ((doc (documentation-property symbol 'group-documentation t)))
1723
(when doc
1724
(princ "a group.\n\n")
1725
(princ doc)
1726
(buffer-string)))))))))
1727
1728
(defun ac-symbol-candidates ()
1729
(or ac-symbols-cache
1730
(setq ac-symbols-cache
1731
(loop for x being the symbols
1732
if (or (fboundp x)
1733
(boundp x)
1734
(symbol-plist x))
1735
collect (symbol-name x)))))
1736
1737
(ac-define-source symbols
1738
'((candidates . ac-symbol-candidates)
1739
(document . ac-symbol-documentation)
1740
(symbol . "s")
1741
(cache)))
1742
1743
;; Lisp functions source
1744
(defvar ac-functions-cache nil)
1745
(ac-clear-variable-every-10-minutes 'ac-functions-cache)
1746
1747
(defun ac-function-candidates ()
1748
(or ac-functions-cache
1749
(setq ac-functions-cache
1750
(loop for x being the symbols
1751
if (fboundp x)
1752
collect (symbol-name x)))))
1753
1754
(ac-define-source functions
1755
'((candidates . ac-function-candidates)
1756
(document . ac-symbol-documentation)
1757
(symbol . "f")
1758
(prefix . "(\\(\\(?:\\sw\\|\\s_\\)+\\)")
1759
(cache)))
1760
1761
;; Lisp variables source
1762
(defvar ac-variables-cache nil)
1763
(ac-clear-variable-every-10-minutes 'ac-variables-cache)
1764
1765
(defun ac-variable-candidates ()
1766
(or ac-variables-cache
1767
(setq ac-variables-cache
1768
(loop for x being the symbols
1769
if (boundp x)
1770
collect (symbol-name x)))))
1771
1772
(ac-define-source variables
1773
'((candidates . ac-variable-candidates)
1774
(document . ac-symbol-documentation)
1775
(symbol . "v")
1776
(cache)))
1777
1778
;; Lisp features source
1779
(defvar ac-emacs-lisp-features nil)
1780
(ac-clear-variable-every-10-minutes 'ac-emacs-lisp-features)
1781
1782
(defun ac-emacs-lisp-feature-candidates ()
1783
(or ac-emacs-lisp-features
1784
(if (fboundp 'find-library-suffixes)
1785
(let ((suffix (concat (regexp-opt (find-library-suffixes) t) "\\'")))
1786
(setq ac-emacs-lisp-features
1787
(append (mapcar 'prin1-to-string features)
1788
(loop for dir in load-path
1789
if (file-directory-p dir)
1790
append (loop for file in (directory-files dir)
1791
if (string-match suffix file)
1792
collect (substring file 0 (match-beginning 0))))))))))
1793
1794
(ac-define-source features
1795
'((depends find-func)
1796
(candidates . ac-emacs-lisp-feature-candidates)
1797
(prefix . "require +'\\(\\(?:\\sw\\|\\s_\\)*\\)")
1798
(requires . 0)))
1799
1800
(defvaralias 'ac-source-emacs-lisp-features 'ac-source-features)
1801
1802
;; Abbrev source
1803
(ac-define-source abbrev
1804
'((candidates . (mapcar 'popup-x-to-string (append (vconcat local-abbrev-table global-abbrev-table) nil)))
1805
(action . expand-abbrev)
1806
(symbol . "a")
1807
(cache)))
1808
1809
;; Files in current directory source
1810
(ac-define-source files-in-current-dir
1811
'((candidates . (directory-files default-directory))
1812
(cache)))
1813
1814
;; Filename source
1815
(defvar ac-filename-cache nil)
1816
1817
(defun ac-filename-candidate ()
1818
(unless (file-regular-p ac-prefix)
1819
(ignore-errors
1820
(loop with dir = (file-name-directory ac-prefix)
1821
with files = (or (assoc-default dir ac-filename-cache)
1822
(let ((files (directory-files dir nil "^[^.]")))
1823
(push (cons dir files) ac-filename-cache)
1824
files))
1825
for file in files
1826
for path = (concat dir file)
1827
collect (if (file-directory-p path)
1828
(concat path "/")
1829
path)))))
1830
1831
(ac-define-source filename
1832
'((init . (setq ac-filename-cache nil))
1833
(candidates . ac-filename-candidate)
1834
(prefix . valid-file)
1835
(requires . 0)
1836
(action . ac-start)
1837
(limit . nil)))
1838
1839
;; Dictionary source
1840
(defcustom ac-user-dictionary nil
1841
"User dictionary"
1842
:type '(repeat string)
1843
:group 'auto-complete)
1844
1845
(defcustom ac-user-dictionary-files '("~/.dict")
1846
"User dictionary files."
1847
:type '(repeat string)
1848
:group 'auto-complete)
1849
1850
(defcustom ac-dictionary-directories nil
1851
"Dictionary directories."
1852
:type '(repeat string)
1853
:group 'auto-complete)
1854
1855
(defvar ac-dictionary nil)
1856
(defvar ac-dictionary-cache (make-hash-table :test 'equal))
1857
1858
(defun ac-clear-dictionary-cache ()
1859
(interactive)
1860
(clrhash ac-dictionary-cache))
1861
1862
(defun ac-read-file-dictionary (filename)
1863
(let ((cache (gethash filename ac-dictionary-cache 'none)))
1864
(if (and cache (not (eq cache 'none)))
1865
cache
1866
(let (result)
1867
(ignore-errors
1868
(with-temp-buffer
1869
(insert-file-contents filename)
1870
(setq result (split-string (buffer-string) "\n"))))
1871
(puthash filename result ac-dictionary-cache)
1872
result))))
1873
1874
(defun ac-buffer-dictionary ()
1875
(apply 'append
1876
(mapcar 'ac-read-file-dictionary
1877
(mapcar (lambda (name)
1878
(loop for dir in ac-dictionary-directories
1879
for file = (concat dir "/" name)
1880
if (file-exists-p file)
1881
return file))
1882
(list (symbol-name major-mode)
1883
(ignore-errors
1884
(file-name-extension (buffer-file-name))))))))
1885
1886
(defun ac-dictionary-candidates ()
1887
(apply 'append `(,ac-user-dictionary
1888
,(ac-buffer-dictionary)
1889
,@(mapcar 'ac-read-file-dictionary
1890
ac-user-dictionary-files))))
1891
1892
(ac-define-source dictionary
1893
'((candidates . ac-dictionary-candidates)
1894
(symbol . "d")))
1895
1896
(provide 'auto-complete)
1897
;;; auto-complete.el ends here
1898
1899