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