Mercurial > emacs
comparison lisp/gnus/ecomplete.el @ 85712:a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 28 Oct 2007 09:18:39 +0000 |
parents | |
children | 718a6e9eaa1b |
comparison
equal
deleted
inserted
replaced
85711:b6f5dc84b2e1 | 85712:a3c27999decb |
---|---|
1 ;;; ecomplete.el --- electric completion of addresses and the like | |
2 ;; Copyright (C) 2006 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
5 ;; Keywords: mail | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 3, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
22 ;; Boston, MA 02110-1301, USA. | |
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 | |
60 (format "%.0f" (time-to-seconds (current-time))))) | |
61 entry) | |
62 (unless elems | |
63 (push (setq elems (list type)) ecomplete-database)) | |
64 (if (setq entry (assoc key (cdr elems))) | |
65 (setcdr entry (list (1+ (cadr entry)) now text)) | |
66 (nconc elems (list (list key 1 now text)))))) | |
67 | |
68 (defun ecomplete-get-item (type key) | |
69 (assoc key (cdr (assq type ecomplete-database)))) | |
70 | |
71 (defun ecomplete-save () | |
72 (with-temp-buffer | |
73 (let ((coding-system-for-write ecomplete-database-file-coding-system)) | |
74 (insert "(") | |
75 (loop for (type . elems) in ecomplete-database | |
76 do | |
77 (insert (format "(%s\n" type)) | |
78 (dolist (entry elems) | |
79 (prin1 entry (current-buffer)) | |
80 (insert "\n")) | |
81 (insert ")\n")) | |
82 (insert ")") | |
83 (write-region (point-min) (point-max) | |
84 ecomplete-database-file nil 'silent)))) | |
85 | |
86 (defun ecomplete-get-matches (type match) | |
87 (let* ((elems (cdr (assq type ecomplete-database))) | |
88 (match (regexp-quote match)) | |
89 (candidates | |
90 (sort | |
91 (loop for (key count time text) in elems | |
92 when (string-match match text) | |
93 collect (list count time text)) | |
94 (lambda (l1 l2) | |
95 (> (car l1) (car l2)))))) | |
96 (when (> (length candidates) 10) | |
97 (setcdr (nthcdr 10 candidates) nil)) | |
98 (unless (zerop (length candidates)) | |
99 (with-temp-buffer | |
100 (dolist (candidate candidates) | |
101 (insert (caddr candidate) "\n")) | |
102 (goto-char (point-min)) | |
103 (put-text-property (point) (1+ (point)) 'ecomplete t) | |
104 (while (re-search-forward match nil t) | |
105 (put-text-property (match-beginning 0) (match-end 0) | |
106 'face 'isearch)) | |
107 (buffer-string))))) | |
108 | |
109 (defun ecomplete-display-matches (type word &optional choose) | |
110 (let* ((matches (ecomplete-get-matches type word)) | |
111 (line 0) | |
112 (max-lines (when matches (- (length (split-string matches "\n")) 2))) | |
113 (message-log-max nil) | |
114 command highlight) | |
115 (if (not matches) | |
116 (progn | |
117 (message "No ecomplete matches") | |
118 nil) | |
119 (if (not choose) | |
120 (progn | |
121 (message matches) | |
122 nil) | |
123 (setq highlight (ecomplete-highlight-match-line matches line)) | |
124 (while (not (memq (setq command (read-event highlight)) '(? return))) | |
125 (cond | |
126 ((eq command ?\M-n) | |
127 (setq line (min (1+ line) max-lines))) | |
128 ((eq command ?\M-p) | |
129 (setq line (max (1- line) 0)))) | |
130 (setq highlight (ecomplete-highlight-match-line matches line))) | |
131 (when (eq command 'return) | |
132 (nth line (split-string matches "\n"))))))) | |
133 | |
134 (defun ecomplete-highlight-match-line (matches line) | |
135 (with-temp-buffer | |
136 (insert matches) | |
137 (goto-char (point-min)) | |
138 (forward-line line) | |
139 (save-restriction | |
140 (narrow-to-region (point) (point-at-eol)) | |
141 (while (not (eobp)) | |
142 ;; Put the 'region face on any charactes on this line that | |
143 ;; aren't already highlighted. | |
144 (unless (get-text-property (point) 'face) | |
145 (put-text-property (point) (1+ (point)) 'face 'highlight)) | |
146 (forward-char 1))) | |
147 (buffer-string))) | |
148 | |
149 (provide 'ecomplete) | |
150 | |
151 ;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72 | |
152 ;;; ecomplete.el ends here |