Commit | Line | Data |
---|---|---|
01c52d31 | 1 | ;;; ecomplete.el --- electric completion of addresses and the like |
57164861 | 2 | |
5df4f04c | 3 | ;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 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 | ||
30 | (defgroup ecomplete nil | |
31 | "Electric completion of email addresses and the like." | |
32 | :group 'mail) | |
33 | ||
34 | (defcustom ecomplete-database-file "~/.ecompleterc" | |
35 | "*The name of the file to store the ecomplete data." | |
36 | :group 'ecomplete | |
37 | :type 'file) | |
38 | ||
39 | (defcustom ecomplete-database-file-coding-system 'iso-2022-7bit | |
40 | "Coding system used for writing the ecomplete database file." | |
41 | :type '(symbol :tag "Coding system") | |
42 | :group 'ecomplete) | |
43 | ||
44 | ;;; Internal variables. | |
45 | ||
46 | (defvar ecomplete-database nil) | |
47 | ||
48 | ;;;###autoload | |
49 | (defun ecomplete-setup () | |
50 | (when (file-exists-p ecomplete-database-file) | |
51 | (with-temp-buffer | |
52 | (let ((coding-system-for-read ecomplete-database-file-coding-system)) | |
53 | (insert-file-contents ecomplete-database-file) | |
54 | (setq ecomplete-database (read (current-buffer))))))) | |
55 | ||
56 | (defun ecomplete-add-item (type key text) | |
57 | (let ((elems (assq type ecomplete-database)) | |
58 | (now (string-to-number | |
6f0d4bb6 | 59 | (format "%.0f" (if (featurep 'emacs) |
de0bdfe7 | 60 | (float-time) |
6f0d4bb6 GM |
61 | (require 'gnus-util) |
62 | (gnus-float-time))))) | |
01c52d31 MB |
63 | entry) |
64 | (unless elems | |
65 | (push (setq elems (list type)) ecomplete-database)) | |
66 | (if (setq entry (assoc key (cdr elems))) | |
67 | (setcdr entry (list (1+ (cadr entry)) now text)) | |
68 | (nconc elems (list (list key 1 now text)))))) | |
69 | ||
70 | (defun ecomplete-get-item (type key) | |
71 | (assoc key (cdr (assq type ecomplete-database)))) | |
72 | ||
73 | (defun ecomplete-save () | |
74 | (with-temp-buffer | |
75 | (let ((coding-system-for-write ecomplete-database-file-coding-system)) | |
76 | (insert "(") | |
77 | (loop for (type . elems) in ecomplete-database | |
78 | do | |
79 | (insert (format "(%s\n" type)) | |
80 | (dolist (entry elems) | |
81 | (prin1 entry (current-buffer)) | |
82 | (insert "\n")) | |
83 | (insert ")\n")) | |
84 | (insert ")") | |
85 | (write-region (point-min) (point-max) | |
86 | ecomplete-database-file nil 'silent)))) | |
87 | ||
88 | (defun ecomplete-get-matches (type match) | |
89 | (let* ((elems (cdr (assq type ecomplete-database))) | |
90 | (match (regexp-quote match)) | |
91 | (candidates | |
c9fc72fa | 92 | (sort |
01c52d31 MB |
93 | (loop for (key count time text) in elems |
94 | when (string-match match text) | |
95 | collect (list count time text)) | |
96 | (lambda (l1 l2) | |
97 | (> (car l1) (car l2)))))) | |
98 | (when (> (length candidates) 10) | |
99 | (setcdr (nthcdr 10 candidates) nil)) | |
100 | (unless (zerop (length candidates)) | |
101 | (with-temp-buffer | |
102 | (dolist (candidate candidates) | |
103 | (insert (caddr candidate) "\n")) | |
104 | (goto-char (point-min)) | |
105 | (put-text-property (point) (1+ (point)) 'ecomplete t) | |
106 | (while (re-search-forward match nil t) | |
107 | (put-text-property (match-beginning 0) (match-end 0) | |
108 | 'face 'isearch)) | |
109 | (buffer-string))))) | |
110 | ||
111 | (defun ecomplete-display-matches (type word &optional choose) | |
112 | (let* ((matches (ecomplete-get-matches type word)) | |
113 | (line 0) | |
114 | (max-lines (when matches (- (length (split-string matches "\n")) 2))) | |
115 | (message-log-max nil) | |
116 | command highlight) | |
117 | (if (not matches) | |
118 | (progn | |
119 | (message "No ecomplete matches") | |
120 | nil) | |
121 | (if (not choose) | |
122 | (progn | |
274f1353 | 123 | (message "%s" matches) |
01c52d31 MB |
124 | nil) |
125 | (setq highlight (ecomplete-highlight-match-line matches line)) | |
126 | (while (not (memq (setq command (read-event highlight)) '(? return))) | |
127 | (cond | |
128 | ((eq command ?\M-n) | |
129 | (setq line (min (1+ line) max-lines))) | |
130 | ((eq command ?\M-p) | |
131 | (setq line (max (1- line) 0)))) | |
132 | (setq highlight (ecomplete-highlight-match-line matches line))) | |
133 | (when (eq command 'return) | |
134 | (nth line (split-string matches "\n"))))))) | |
135 | ||
136 | (defun ecomplete-highlight-match-line (matches line) | |
137 | (with-temp-buffer | |
138 | (insert matches) | |
139 | (goto-char (point-min)) | |
140 | (forward-line line) | |
141 | (save-restriction | |
142 | (narrow-to-region (point) (point-at-eol)) | |
143 | (while (not (eobp)) | |
ab67634f | 144 | ;; Put the 'region face on any characters on this line that |
01c52d31 MB |
145 | ;; aren't already highlighted. |
146 | (unless (get-text-property (point) 'face) | |
147 | (put-text-property (point) (1+ (point)) 'face 'highlight)) | |
148 | (forward-char 1))) | |
149 | (buffer-string))) | |
150 | ||
151 | (provide 'ecomplete) | |
152 | ||
01c52d31 | 153 | ;;; ecomplete.el ends here |