PageRenderTime 52ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 1ms

/lisp/gnus/ecomplete.el

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