1 ;;; ecomplete.el --- electric completion of addresses and the like
3 ;; Copyright (C) 2006-2018 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs 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.
15 ;; GNU Emacs 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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
25 ;; ecomplete stores matches in a file that looks like this:
28 ;; ("larsi@gnus.org" 38154 1516109510 "Lars Ingebrigtsen <larsi@gnus.org>")
29 ;; ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel <kfogel@red-bean.com>")
33 ;; That is, it's an alist map where the key is the "type" of match (so
34 ;; that you can have one list of things for `mail' and one for, say,
35 ;; `twitter'). In each of these sections you then have a list where
36 ;; each item is on the form
38 ;; (KEY TIMES-USED LAST-TIME-USED STRING)
40 ;; If you call `ecomplete-display-matches', it will then display all
41 ;; items that match STRING. KEY is unique and is used to identify the
42 ;; item, and is used for updates. For instance, if given the above
45 ;; (ecomplete-add-item "larsi@gnus.org" 'mail "Lars Magne Ingebrigtsen <larsi@gnus.org>")
47 ;; the "larsi@gnus.org" entry will then be updated with that new STRING.
49 ;; The interface functions are `ecomplete-add-item' and
50 ;; `ecomplete-display-matches', while `ecomplete-setup' should be
51 ;; called to read the .ecompleterc file, and `ecomplete-save' are
52 ;; called to save the file.
59 (defgroup ecomplete nil
60 "Electric completion of email addresses and the like."
63 (defcustom ecomplete-database-file
"~/.ecompleterc"
64 "The name of the file to store the ecomplete data."
68 (defcustom ecomplete-database-file-coding-system
'iso-2022-7bit
69 "Coding system used for writing the ecomplete database file."
70 :type
'(symbol :tag
"Coding system")
73 ;;; Internal variables.
75 (defvar ecomplete-database nil
)
78 (defun ecomplete-setup ()
79 "Read the .ecompleterc file."
80 (when (file-exists-p ecomplete-database-file
)
82 (let ((coding-system-for-read ecomplete-database-file-coding-system
))
83 (insert-file-contents ecomplete-database-file
)
84 (setq ecomplete-database
(read (current-buffer)))))))
86 (defun ecomplete-add-item (type key text
)
87 "Add item TEXT of TYPE to the database, using KEY as the identifier."
88 (let ((elems (assq type ecomplete-database
))
89 (now (string-to-number (format-time-string "%s")))
92 (push (setq elems
(list type
)) ecomplete-database
))
93 (if (setq entry
(assoc key
(cdr elems
)))
94 (setcdr entry
(list (1+ (cadr entry
)) now text
))
95 (nconc elems
(list (list key
1 now text
))))))
97 (defun ecomplete-get-item (type key
)
98 "Return the text for the item identified by KEY of the required TYPE."
99 (assoc key
(cdr (assq type ecomplete-database
))))
101 (defun ecomplete-save ()
102 "Write the .ecompleterc file."
104 (let ((coding-system-for-write ecomplete-database-file-coding-system
))
106 (loop for
(type . elems
) in ecomplete-database
108 (insert (format "(%s\n" type
))
109 (dolist (entry elems
)
110 (prin1 entry
(current-buffer))
114 (write-region (point-min) (point-max)
115 ecomplete-database-file nil
'silent
))))
117 (defun ecomplete-get-matches (type match
)
118 (let* ((elems (cdr (assq type ecomplete-database
)))
119 (match (regexp-quote match
))
122 (loop for
(key count time text
) in elems
123 when
(string-match match text
)
124 collect
(list count time text
))
126 (> (car l1
) (car l2
))))))
127 (when (> (length candidates
) 10)
128 (setcdr (nthcdr 10 candidates
) nil
))
129 (unless (zerop (length candidates
))
131 (dolist (candidate candidates
)
132 (insert (caddr candidate
) "\n"))
133 (goto-char (point-min))
134 (put-text-property (point) (1+ (point)) 'ecomplete t
)
135 (while (re-search-forward match nil t
)
136 (put-text-property (match-beginning 0) (match-end 0)
140 (defun ecomplete-display-matches (type word
&optional choose
)
141 "Display the top-rated elements TYPE that match WORD.
142 If CHOOSE, allow the user to choose interactively between the
144 (let* ((matches (ecomplete-get-matches type word
))
146 (max-lines (when matches
(- (length (split-string matches
"\n")) 2)))
147 (message-log-max nil
)
151 (message "No ecomplete matches")
155 (message "%s" matches
)
157 (setq highlight
(ecomplete-highlight-match-line matches line
))
158 (let ((local-map (make-sparse-keymap))
160 (define-key local-map
(kbd "RET")
161 (lambda () (setq selected
(nth line
(split-string matches
"\n")))))
162 (define-key local-map
(kbd "M-n")
163 (lambda () (setq line
(min (1+ line
) max-lines
))))
164 (define-key local-map
(kbd "M-p")
165 (lambda () (setq line
(max (1- line
) 0))))
166 (let ((overriding-local-map local-map
))
167 (while (and (null selected
)
168 (setq command
(read-key-sequence highlight
))
169 (lookup-key local-map command
))
170 (apply (key-binding command
) nil
)
171 (setq highlight
(ecomplete-highlight-match-line matches line
))))
177 (defun ecomplete-highlight-match-line (matches line
)
180 (goto-char (point-min))
183 (narrow-to-region (point) (point-at-eol))
185 ;; Put the 'region face on any characters on this line that
186 ;; aren't already highlighted.
187 (unless (get-text-property (point) 'face
)
188 (put-text-property (point) (1+ (point)) 'face
'highlight
))
194 ;;; ecomplete.el ends here