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