Commit | Line | Data |
---|---|---|
01c52d31 | 1 | ;;; ecomplete.el --- electric completion of addresses and the like |
57164861 | 2 | |
114f9c96 | 3 | ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 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 | ||
de0bdfe7 KY |
30 | (eval-when-compile |
31 | (unless (fboundp 'with-no-warnings) | |
32 | (defmacro with-no-warnings (&rest body) | |
33 | `(progn ,@body)))) | |
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 | |
de0bdfe7 KY |
64 | (format "%.0f" (if (and (fboundp 'float-time) |
65 | (subrp (symbol-function 'float-time))) | |
66 | (float-time) | |
67 | (with-no-warnings | |
68 | (time-to-seconds (current-time))))))) | |
01c52d31 MB |
69 | entry) |
70 | (unless elems | |
71 | (push (setq elems (list type)) ecomplete-database)) | |
72 | (if (setq entry (assoc key (cdr elems))) | |
73 | (setcdr entry (list (1+ (cadr entry)) now text)) | |
74 | (nconc elems (list (list key 1 now text)))))) | |
75 | ||
76 | (defun ecomplete-get-item (type key) | |
77 | (assoc key (cdr (assq type ecomplete-database)))) | |
78 | ||
79 | (defun ecomplete-save () | |
80 | (with-temp-buffer | |
81 | (let ((coding-system-for-write ecomplete-database-file-coding-system)) | |
82 | (insert "(") | |
83 | (loop for (type . elems) in ecomplete-database | |
84 | do | |
85 | (insert (format "(%s\n" type)) | |
86 | (dolist (entry elems) | |
87 | (prin1 entry (current-buffer)) | |
88 | (insert "\n")) | |
89 | (insert ")\n")) | |
90 | (insert ")") | |
91 | (write-region (point-min) (point-max) | |
92 | ecomplete-database-file nil 'silent)))) | |
93 | ||
94 | (defun ecomplete-get-matches (type match) | |
95 | (let* ((elems (cdr (assq type ecomplete-database))) | |
96 | (match (regexp-quote match)) | |
97 | (candidates | |
98 | (sort | |
99 | (loop for (key count time text) in elems | |
100 | when (string-match match text) | |
101 | collect (list count time text)) | |
102 | (lambda (l1 l2) | |
103 | (> (car l1) (car l2)))))) | |
104 | (when (> (length candidates) 10) | |
105 | (setcdr (nthcdr 10 candidates) nil)) | |
106 | (unless (zerop (length candidates)) | |
107 | (with-temp-buffer | |
108 | (dolist (candidate candidates) | |
109 | (insert (caddr candidate) "\n")) | |
110 | (goto-char (point-min)) | |
111 | (put-text-property (point) (1+ (point)) 'ecomplete t) | |
112 | (while (re-search-forward match nil t) | |
113 | (put-text-property (match-beginning 0) (match-end 0) | |
114 | 'face 'isearch)) | |
115 | (buffer-string))))) | |
116 | ||
117 | (defun ecomplete-display-matches (type word &optional choose) | |
118 | (let* ((matches (ecomplete-get-matches type word)) | |
119 | (line 0) | |
120 | (max-lines (when matches (- (length (split-string matches "\n")) 2))) | |
121 | (message-log-max nil) | |
122 | command highlight) | |
123 | (if (not matches) | |
124 | (progn | |
125 | (message "No ecomplete matches") | |
126 | nil) | |
127 | (if (not choose) | |
128 | (progn | |
274f1353 | 129 | (message "%s" matches) |
01c52d31 MB |
130 | nil) |
131 | (setq highlight (ecomplete-highlight-match-line matches line)) | |
132 | (while (not (memq (setq command (read-event highlight)) '(? return))) | |
133 | (cond | |
134 | ((eq command ?\M-n) | |
135 | (setq line (min (1+ line) max-lines))) | |
136 | ((eq command ?\M-p) | |
137 | (setq line (max (1- line) 0)))) | |
138 | (setq highlight (ecomplete-highlight-match-line matches line))) | |
139 | (when (eq command 'return) | |
140 | (nth line (split-string matches "\n"))))))) | |
141 | ||
142 | (defun ecomplete-highlight-match-line (matches line) | |
143 | (with-temp-buffer | |
144 | (insert matches) | |
145 | (goto-char (point-min)) | |
146 | (forward-line line) | |
147 | (save-restriction | |
148 | (narrow-to-region (point) (point-at-eol)) | |
149 | (while (not (eobp)) | |
150 | ;; Put the 'region face on any charactes on this line that | |
151 | ;; aren't already highlighted. | |
152 | (unless (get-text-property (point) 'face) | |
153 | (put-text-property (point) (1+ (point)) 'face 'highlight)) | |
154 | (forward-char 1))) | |
155 | (buffer-string))) | |
156 | ||
157 | (provide 'ecomplete) | |
158 | ||
159 | ;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72 | |
160 | ;;; ecomplete.el ends here |