1 ;;; popcmp.el --- Completion enhancements, popup etc
3 ;; Author: Lennart Borgman
4 ;; Created: Tue Jan 09 12:00:29 2007
6 ;; Last-Updated: 2008-03-08T03:30:15+0100 Sat
10 ;; Features that might be required by this library:
12 ;; `ourcomments-util'.
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;; This program is free software; you can redistribute it and/or modify
28 ;; it under the terms of the GNU General Public License as published by
29 ;; the Free Software Foundation; either version 2, or (at your option)
32 ;; This program is distributed in the hope that it will be useful,
33 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
34 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
35 ;; GNU General Public License for more details.
37 ;; You should have received a copy of the GNU General Public License
38 ;; along with this program; see the file COPYING. If not, write to the
39 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
40 ;; Boston, MA 02111-1307, USA.
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
46 (eval-when-compile (require 'cl))
47 (eval-when-compile (require 'ourcomments-util nil t))
51 "Customization group for popup completion."
52 :tag "Completion Style \(popup etc)"
56 ;; (define-toggle popcmp-popup-completion t
57 ;; "Use a popup menu for some completions if non-nil.
59 ;; ***** Obsolete: Use `popcmp-completion-style' instead.
61 ;; When completion is used for alternatives tighed to text at the
62 ;; point in buffer it may make sense to use a popup menu for
63 ;; completion. This variable let you decide whether normal style
64 ;; completion or popup style completion should be used then.
66 ;; This style of completion is not implemented for all completions.
67 ;; It is implemented for specific cases but the choice of completion
68 ;; style is managed generally by this variable for all these cases.
70 ;; See also the options `popcmp-short-help-beside-alts' and
71 ;; `popcmp-group-alternatives' which are also availabe when popup
72 ;; completion is available."
73 ;; :tag "Popup style completion"
76 (defun popcmp-cant-use-style (style)
77 (save-match-data ;; runs in timer
78 (describe-variable 'popcmp-completion-style)
79 (message (propertize "popcmp-completion-style: style `%s' is not available"
80 'face 'secondary-selection)
85 (defun popcmp-set-completion-style (val)
86 "Internal use, set `popcmp-completion-style' to VAL."
87 (assert (memq val '(popcmp-popup emacs-default company-mode anything)) t)
89 ('company-mode (unless (fboundp 'company-mode)
90 (require 'company-mode nil t))
91 (unless (fboundp 'company-mode)
92 (run-with-idle-timer 1 nil 'popcmp-cant-use-style val)
93 (setq val 'popcmp-popup)))
94 ('anything (unless (fboundp 'anything)
95 (require 'anything nil t))
96 (unless (fboundp 'anything)
97 (run-with-idle-timer 1 nil 'popcmp-cant-use-style val)
98 (setq val 'popcmp-popup))))
99 (set-default 'popcmp-completion-style val)
100 (unless (eq val 'company-mode)
101 (when (and (boundp 'global-company-mode)
103 (global-company-mode -1))
104 (remove-hook 'after-change-major-mode-hook 'company-set-major-mode-backend)
105 (remove-hook 'mumamo-after-change-major-mode-hook 'mumamo-turn-on-company-mode))
106 (when (eq val 'company-mode)
107 (unless (and (boundp 'global-company-mode)
109 (global-company-mode 1))
110 (add-hook 'after-change-major-mode-hook 'company-set-major-mode-backend)
111 (add-hook 'mumamo-after-change-major-mode-hook 'mumamo-turn-on-company-mode)))
113 ;; fix-me: move to mumamo.el
114 (defun mumamo-turn-on-company-mode ()
115 (when (and (boundp 'company-mode)
118 (company-set-major-mode-backend)))
121 (defcustom popcmp-completion-style (cond
122 ;;((and (fboundp 'global-company-mode) 'company-mode) 'company-mode)
125 The currently available completion styles are:
127 - popcmp-popup: Use OS popup menus (default).
128 - emacs-default: Emacs default completion.
129 - Company Mode completion.
130 - anything: The Anything elisp lib completion style.
132 The style of completion set here is not implemented for all
133 completions. The scope varies however with which completion
134 style you have choosen.
136 For information about Company Mode and how to use it see URL
137 `http://www.emacswiki.org/emacs/CompanyMode'.
139 For information about Anything and how to use it see URL
140 `http://www.emacswiki.org/emacs/Anything'.
142 See also the options `popcmp-short-help-beside-alts' and
143 `popcmp-group-alternatives' which are also availabe when popup
144 completion is available."
145 :type '(choice (const company-mode)
147 (const emacs-default)
149 :set (lambda (sym val)
150 (popcmp-set-completion-style val))
153 ;;(define-toggle popcmp-short-help-beside-alts t
154 (define-minor-mode popcmp-short-help-beside-alts
155 "Show a short help text beside each alternative.
156 If this is non-nil a short help text is shown beside each
157 alternative for which such a help text is available.
159 This works in the same circumstances as
160 `popcmp-completion-style'."
161 :tag "Short help beside alternatives"
166 (defun popcmp-short-help-beside-alts-toggle ()
167 "Toggle `popcmp-short-help-beside-alts'."
168 (popcmp-short-help-beside-alts (if popcmp-short-help-beside-alts -1 1)))
170 ;;(define-toggle popcmp-group-alternatives t
171 (define-minor-mode popcmp-group-alternatives
172 "Do completion in two steps.
173 For some completions the alternatives may have been grouped in
174 sets. If this option is non-nil then you will first choose a set
175 and then an alternative within this set.
177 This works in the same circumstances as
178 `popcmp-completion-style'."
179 :tag "Group alternatives"
184 (defun popcmp-group-alternatives-toggle ()
185 "Toggle `popcmp-group-alternatives-toggle'."
187 (popcmp-group-alternatives (if popcmp-group-alternatives -1 1)))
189 (defun popcmp-getsets (alts available-sets)
193 (dolist (s available-sets)
194 (when (member tg (cdr s))
196 (let ((sets-entry (assq (car s) sets)))
198 (setq sets (cons (list (car s)) sets))
199 (setq sets-entry (assq (car s) sets)))
200 (setcdr sets-entry (cons tg (cdr sets-entry))))))
202 (let ((sets-entry (assq 'unsorted sets)))
204 (setq sets (cons (list 'unsorted) sets))
205 (setq sets-entry (assq 'unsorted sets)))
206 (setcdr sets-entry (cons tg (cdr sets-entry)))))))
207 (setq sets (sort sets (lambda (a b)
208 (string< (format "%s" b)
210 ;;(dolist (s sets) (setcdr s (reverse (cdr s))))
213 (defun popcmp-getset-alts (set-name sets)
214 ;; Allow both strings and symbols as keys:
215 (let ((set (or (assoc (downcase set-name) sets)
216 (assoc (read (downcase set-name)) sets))))
219 (defvar popcmp-completing-with-help nil)
221 (defun popcmp-add-help (alt alt-help-hash)
223 (let ((h (if (hash-table-p alt-help-hash)
224 (gethash alt alt-help-hash)
225 (let ((hh (assoc alt alt-help-hash)))
229 (concat alt " -- " h)
233 (defun popcmp-remove-help (alt-with-help)
235 (replace-regexp-in-string " -- .*" "" alt-with-help)))
237 (defun popcmp-anything (prompt collection
238 predicate require-match
239 initial-input hist def inherit-input-method
241 (let* ((table collection)
242 (alt-sets2 (apply 'append (mapcar 'cdr alt-sets)))
243 (cands (cond ((not (listp table)) alt-sets2)
246 (source `((name . "Completion candidates")
247 (candidates . ,cands)
248 (action . (("Select current alternative (press TAB to see it again)" . (lambda (candidate)
249 (setq ret-val candidate))))))))
250 (anything (list source) initial-input prompt)
253 (defun popcmp-completing-read-1 (prompt collection
254 predicate require-match
255 initial-input hist2 def inherit-input-method alt-help alt-sets)
256 ;; Fix-me: must rename hist to hist2 in par list. Emacs bug?
258 ((eq popcmp-completion-style 'emacs-default)
259 (completing-read prompt collection predicate require-match initial-input hist2 def inherit-input-method))
260 ((eq popcmp-completion-style 'anything)
261 (popcmp-anything prompt collection predicate require-match initial-input hist2 def inherit-input-method
263 ((eq popcmp-completion-style 'company-mode)
264 ;; No way to read this from company-mode, use emacs-default
265 (completing-read prompt collection predicate require-match initial-input hist2 def inherit-input-method))
266 (t (error "Do not know popcmp-completion-style %S" popcmp-completion-style))))
268 (defun popcmp-completing-read-other (prompt
270 &optional predicate require-match
271 initial-input pop-hist def inherit-input-method
275 (if (and popcmp-group-alternatives alt-sets)
276 (all-completions initial-input table predicate)
277 (if popcmp-short-help-beside-alts
278 (all-completions "" table predicate)
280 (when (and popcmp-group-alternatives alt-sets)
281 (let* ((sets (popcmp-getsets alts alt-sets))
282 (set-names (mapcar (lambda (elt)
283 (capitalize (format "%s" (car elt))))
287 (popcmp-completing-read-1 (concat
288 (substring prompt 0 (- (length prompt) 2))
292 nil nil nil inherit-input-method nil nil))
293 (if (or (not set) (= 0 (length set)))
295 (setq set (downcase set))
296 (setq alts (popcmp-getset-alts set sets)))))
299 (if (= 1 (length alts))
301 (when popcmp-short-help-beside-alts
302 (setq alts (mapcar (lambda (a)
303 (popcmp-add-help a alt-help))
306 ;;(completing-read prompt
307 (popcmp-completing-read-1 prompt
309 predicate require-match
310 initial-input pop-hist def inherit-input-method
315 (defun popcmp-completing-read-pop (prompt
317 &optional predicate require-match
318 initial-input hist def inherit-input-method
321 (unless initial-input
322 (setq initial-input ""))
323 (let ((matching-alts (all-completions initial-input table predicate))
325 (if (not matching-alts)
327 (message "No alternative found")
329 (let ((pop-map (make-sparse-keymap prompt))
330 (sets (when (and popcmp-group-alternatives alt-sets)
331 (popcmp-getsets matching-alts alt-sets)))
332 (add-alt (lambda (k tg)
334 (read (format "[popcmp-%s]" (replace-regexp-in-string " " "-" tg)))
336 (popcmp-add-help tg alt-help)
339 (setq completion ,tg)))))))
342 (let ((k (make-sparse-keymap)))
344 (funcall add-alt k tg))
346 (read (format "[popcmps-%s]" (car s)))
348 (capitalize (format "%s" (car s)))
350 (dolist (tg matching-alts)
351 (funcall add-alt pop-map tg)))
352 (popup-menu-at-point pop-map)
355 (defvar popcmp-in-buffer-allowed nil)
358 (defun popcmp-completing-read (prompt
360 &optional predicate require-match
361 initial-input pop-hist def inherit-input-method
364 "Read a string in the minubuffer with completion, or popup a menu.
365 This function can be used instead `completing-read'. The main
366 purpose is to provide a popup style menu for completion when
367 completion is tighed to text at point in a buffer. If a popup
368 menu is used it will be shown at window point. Whether a popup
369 menu or minibuffer completion is used is governed by
370 `popcmp-completion-style'.
372 The variables PROMPT, TABLE, PREDICATE, REQUIRE-MATCH,
373 INITIAL-INPUT, POP-HIST, DEF and INHERIT-INPUT-METHOD all have the
374 same meaning is for `completing-read'.
376 ALT-HELP should be nil or a hash variable or an association list
377 with the completion alternative as key and a short help text as
378 value. You do not need to supply help text for all alternatives.
379 The use of ALT-HELP is set by `popcmp-short-help-beside-alts'.
381 ALT-SETS should be nil or an association list that has as keys
382 groups and as second element an alternative that should go into
385 (if (and popcmp-in-buffer-allowed
386 (eq popcmp-completion-style 'company-mode)
387 (boundp 'company-mode)
390 (add-hook 'company-completion-finished-hook 'nxhtml-complete-tag-do-also-for-state-completion t)
391 ;;(remove-hook 'company-completion-finished-hook 'nxhtml-complete-tag-do-also-for-state-completion)
392 (call-interactively 'company-nxml)
395 (popcmp-mark-completing initial-input)
396 (let ((err-sym 'quit)
400 (if (eq popcmp-completion-style 'popcmp-popup)
403 (popcmp-completing-read-pop
406 predicate require-match
407 initial-input pop-hist def inherit-input-method
410 ;;(condition-case err
412 (setq ret (popcmp-completing-read-other
415 predicate require-match
416 initial-input pop-hist def inherit-input-method
419 ;; Unless quit or error in Anything we come here:
420 ;;(message "ret=(%S)" ret)
421 (when (and ret (not (string= ret "")))
424 ;; ;;(message "err=%S" err)
425 ;; (setq err-sym (car err))
426 ;; (setq err-val (cdr err))))
428 (popcmp-unmark-completing)
429 (when err-sym (signal err-sym err-val))))))
431 (defvar popcmp-mark-completing-ovl nil)
433 (defun popcmp-mark-completing (initial-input)
434 (let ((start (- (point) (length initial-input)))
436 (if (overlayp popcmp-mark-completing-ovl)
437 (move-overlay popcmp-mark-completing-ovl start end)
438 (setq popcmp-mark-completing-ovl (make-overlay start end))
439 (overlay-put popcmp-mark-completing-ovl 'face 'match)))
442 (defun popcmp-unmark-completing ()
443 (when popcmp-mark-completing-ovl
444 (delete-overlay popcmp-mark-completing-ovl)))
447 ;; (defun popcmp-temp ()
449 ;; (let* ((coord (point-to-coord (point)))
450 ;; (x (nth 0 (car coord)))
451 ;; (y (nth 1 (car coord)))
452 ;; (emacsw32-max-frames nil)
454 ;; (list '(minibuffer . only)
455 ;; '(title . "Input")
456 ;; '(name . "Input frame")
461 ;; '(border-width . 1)
462 ;; '(internal-border-width . 2)
463 ;; '(tool-bar-lines . nil)
464 ;; '(menu-bar-lines . nil)
471 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
472 ;;; popcmp.el ends here