Commit | Line | Data |
---|---|---|
01c52d31 | 1 | ;;; ecomplete.el --- electric completion of addresses and the like |
57164861 | 2 | |
acaf905b | 3 | ;; Copyright (C) 2006-2012 Free Software Foundation, Inc. |
01c52d31 MB |
4 | |
5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
6 | ;; Keywords: mail | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
5e809f55 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
01c52d31 | 11 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
01c52d31 MB |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
5e809f55 | 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
01c52d31 MB |
18 | ;; GNU General Public License for more details. |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
01c52d31 MB |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (eval-when-compile | |
28 | (require 'cl)) | |
29 | ||
465d0300 G |
30 | (eval-when-compile |
31 | (when (featurep 'xemacs) | |
32 | ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. | |
33 | (require 'edmacro))) | |
34 | ||
01c52d31 MB |
35 | (defgroup ecomplete nil |
36 | "Electric completion of email addresses and the like." | |
37 | :group 'mail) | |
38 | ||
39 | (defcustom ecomplete-database-file "~/.ecompleterc" | |
40 | "*The name of the file to store the ecomplete data." | |
41 | :group 'ecomplete | |
42 | :type 'file) | |
43 | ||
44 | (defcustom ecomplete-database-file-coding-system 'iso-2022-7bit | |
45 | "Coding system used for writing the ecomplete database file." | |
46 | :type '(symbol :tag "Coding system") | |
47 | :group 'ecomplete) | |
48 | ||
49 | ;;; Internal variables. | |
50 | ||
51 | (defvar ecomplete-database nil) | |
52 | ||
53 | ;;;###autoload | |
54 | (defun ecomplete-setup () | |
55 | (when (file-exists-p ecomplete-database-file) | |
56 | (with-temp-buffer | |
57 | (let ((coding-system-for-read ecomplete-database-file-coding-system)) | |
58 | (insert-file-contents ecomplete-database-file) | |
59 | (setq ecomplete-database (read (current-buffer))))))) | |
60 | ||
61 | (defun ecomplete-add-item (type key text) | |
62 | (let ((elems (assq type ecomplete-database)) | |
63 | (now (string-to-number | |
6f0d4bb6 | 64 | (format "%.0f" (if (featurep 'emacs) |
de0bdfe7 | 65 | (float-time) |
6f0d4bb6 GM |
66 | (require 'gnus-util) |
67 | (gnus-float-time))))) | |
01c52d31 MB |
68 | entry) |
69 | (unless elems | |
70 | (push (setq elems (list type)) ecomplete-database)) | |
71 | (if (setq entry (assoc key (cdr elems))) | |
72 | (setcdr entry (list (1+ (cadr entry)) now text)) | |
73 | (nconc elems (list (list key 1 now text)))))) | |
74 | ||
75 | (defun ecomplete-get-item (type key) | |
76 | (assoc key (cdr (assq type ecomplete-database)))) | |
77 | ||
78 | (defun ecomplete-save () | |
79 | (with-temp-buffer | |
80 | (let ((coding-system-for-write ecomplete-database-file-coding-system)) | |
81 | (insert "(") | |
82 | (loop for (type . elems) in ecomplete-database | |
83 | do | |
84 | (insert (format "(%s\n" type)) | |
85 | (dolist (entry elems) | |
86 | (prin1 entry (current-buffer)) | |
87 | (insert "\n")) | |
88 | (insert ")\n")) | |
89 | (insert ")") | |
90 | (write-region (point-min) (point-max) | |
91 | ecomplete-database-file nil 'silent)))) | |
92 | ||
93 | (defun ecomplete-get-matches (type match) | |
94 | (let* ((elems (cdr (assq type ecomplete-database))) | |
95 | (match (regexp-quote match)) | |
96 | (candidates | |
c9fc72fa | 97 | (sort |
01c52d31 MB |
98 | (loop for (key count time text) in elems |
99 | when (string-match match text) | |
100 | collect (list count time text)) | |
101 | (lambda (l1 l2) | |
102 | (> (car l1) (car l2)))))) | |
103 | (when (> (length candidates) 10) | |
104 | (setcdr (nthcdr 10 candidates) nil)) | |
105 | (unless (zerop (length candidates)) | |
106 | (with-temp-buffer | |
107 | (dolist (candidate candidates) | |
108 | (insert (caddr candidate) "\n")) | |
109 | (goto-char (point-min)) | |
110 | (put-text-property (point) (1+ (point)) 'ecomplete t) | |
111 | (while (re-search-forward match nil t) | |
112 | (put-text-property (match-beginning 0) (match-end 0) | |
113 | 'face 'isearch)) | |
114 | (buffer-string))))) | |
115 | ||
116 | (defun ecomplete-display-matches (type word &optional choose) | |
117 | (let* ((matches (ecomplete-get-matches type word)) | |
118 | (line 0) | |
119 | (max-lines (when matches (- (length (split-string matches "\n")) 2))) | |
120 | (message-log-max nil) | |
121 | command highlight) | |
122 | (if (not matches) | |
123 | (progn | |
124 | (message "No ecomplete matches") | |
125 | nil) | |
126 | (if (not choose) | |
127 | (progn | |
274f1353 | 128 | (message "%s" matches) |
01c52d31 MB |
129 | nil) |
130 | (setq highlight (ecomplete-highlight-match-line matches line)) | |
465d0300 G |
131 | (let ((local-map (make-sparse-keymap)) |
132 | selected) | |
133 | (define-key local-map (kbd "RET") | |
134 | (lambda () (setq selected (nth line (split-string matches "\n"))))) | |
135 | (define-key local-map (kbd "M-n") | |
136 | (lambda () (setq line (min (1+ line) max-lines)))) | |
137 | (define-key local-map (kbd "M-p") | |
138 | (lambda () (setq line (max (1- line) 0)))) | |
139 | (let ((overriding-local-map local-map)) | |
140 | (while (and (null selected) | |
141 | (setq command (read-key-sequence highlight)) | |
142 | (lookup-key local-map command)) | |
143 | (apply (key-binding command) nil) | |
144 | (setq highlight (ecomplete-highlight-match-line matches line)))) | |
145 | (if selected | |
146 | (message selected) | |
147 | (message "Abort")) | |
148 | selected))))) | |
01c52d31 MB |
149 | |
150 | (defun ecomplete-highlight-match-line (matches line) | |
151 | (with-temp-buffer | |
152 | (insert matches) | |
153 | (goto-char (point-min)) | |
154 | (forward-line line) | |
155 | (save-restriction | |
156 | (narrow-to-region (point) (point-at-eol)) | |
157 | (while (not (eobp)) | |
ab67634f | 158 | ;; Put the 'region face on any characters on this line that |
01c52d31 MB |
159 | ;; aren't already highlighted. |
160 | (unless (get-text-property (point) 'face) | |
161 | (put-text-property (point) (1+ (point)) 'face 'highlight)) | |
162 | (forward-char 1))) | |
163 | (buffer-string))) | |
164 | ||
165 | (provide 'ecomplete) | |
166 | ||
01c52d31 | 167 | ;;; ecomplete.el ends here |