1 ;;; tabkey2.el --- Use second tab key pressed for what you want
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
5 (defconst tabkey2:version "1.40")
6 ;; Last-Updated: 2009-07-15 Wed
7 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/tabkey2.el
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; The tab key is in Emacs often used for indentation. However if you
20 ;; press the tab key a second time and Emacs tries to do indentation
21 ;; again, then usually nothing exciting will happen. Then why not use
22 ;; second tab key in a row for something else?
24 ;; Commonly used completion functions in Emacs is often bound to
25 ;; something corresponding to Alt-Tab. Unfortunately this is unusable
26 ;; if you have a window manager that have an apetite for it (like that
27 ;; on MS Windows for example, and several on GNU/Linux).
29 ;; Then using the second tab key press for completion might be a good
30 ;; choice and perhaps also easy to remember.
32 ;; This little library tries to make it easy to do use the second tab
33 ;; press for completion. Or you can see this library as a swizz army
34 ;; knife for the tab key ;-)
36 ;; See `tabkey2-mode' for more information.
39 ;; This is a generalized of an idea Sebastien Rocca Serra once
40 ;; presented on Emacs Wiki and called "Smart Tab". (It seems like
41 ;; many others have also been using Tab for completion in one way or
42 ;; another for years.)
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49 ;; - Add overlay to display state after first tab.
52 ;; - Fix remove overlay problem.
55 ;; - Add completion function choice.
56 ;; - Add support for popcmp popup completion.
59 ;; - Add informational message after first tab.
62 ;; - Give better informational message after first tab.
65 ;; - Put flyspell first.
68 ;; - Give the overlay higher priority.
71 ;; - Correct tabkey2-completion-functions.
72 ;; - Add double-tab for modes where tab can not be typed again.
73 ;; - Use better condition for when completion can be done, so that it
74 ;; can be done later while still on the same line.
75 ;; - Add a better message handling for the "Tab completion state".
76 ;; - Add C-g break out of the "Tab completion state".
77 ;; - Add faces for highlight.
78 ;; - Make it work in custom mode buffers.
79 ;; - Fix documentation for `tabkey2-first'
82 ;; - Don't call chosen completion function directly. Instead make it
83 ;; default for current buffer.
87 ;; - Add help to C-f1 during "Tab completion state".
88 ;; - Fix documentation basics.
89 ;; - Add customization of state message and line marking.
90 ;; - Fix handling of double-Tab modes.
91 ;; - Make user interaction better.
92 ;; - Handle read-only in custom buffers better.
93 ;; - Add more flexible check for if completion function is active.
94 ;; - Support predictive mode.
95 ;; - Reorder and simplify.
98 ;; - Add org-mode to the double-tab gang.
99 ;; - Make it possible to use double-tab in normal buffers.
100 ;; - Add cycling through completion functions to S-tab.
103 ;; - Fix bug in handling of read-only.
104 ;; - Show completion binding in help message.
105 ;; - Add binding to make current choice buffer local when cycling.
108 ;; - Fix problem at buffer end.
109 ;; - Add S-tab to enter completion state without indentation.
110 ;; - Add backtab bindings too for this.
111 ;; - Remove double-tab, S-tab is better.
112 ;; - Add list of modes that uses more tabs.
113 ;; - Add list of modes that uses tab only for completion.
114 ;; - Move first overlay when indentation changes.
115 ;; - Make mark at line beginning 1 char long.
118 ;; - Don't call tab function when alternate key is pressed.
121 ;; - Let alternate key cycle completion functions instead of complete.
123 ;; - Fix bug when only one completion funciton was available.
124 ;; - Fix bug when alt key and major without fix indent.
127 ;; - Add popup style messages.
128 ;; - Add delay to first message.
129 ;; - Use different face for indicator on line and message.
130 ;; - Use different face for echo area and popup messages.
131 ;; - Add anything to completion functions.
132 ;; - Put help funciton on f1.
133 ;; - Always bind alternate key to cycle.
134 ;; - Change defcustoms to simplify (excuse me).
135 ;; - Work around end of buffer problems.
136 ;; - Work around start of buffer problems.
137 ;; - Assure popup messages are visible.
138 ;; - Reorder code in more logical order.
141 ;; - Make overlay keymap end advance.
142 ;; - Remove overlay keymap parent.
145 ;; - Fix bug on emtpy line.
146 ;; - Fix some text problems.
147 ;; - Make f1 c/k work in tab completion state.
150 ;; - Fixed bug in overlay removal.
153 ;; - Fixed bug in minibuffer setup.
156 ;; - Honour widget-forward, button-forward.
159 ;; - Remove binding of shift tab.
160 ;; - Check if use-region-p is defined.
163 ;; - Add option for completion state mode line marker.
164 ;; - Fix bug in tabkey2-show-completion-functions.
165 ;; - Move off completion point cancels completion state.
166 ;; - Fix bugs in help.
167 ;; - Try to fix some problems with invisible text, at least in
169 ;; - Restore window config, completions often leaves without.
172 ;; - Fix bug in tabkey2-completion-state-p.
175 ;; - Make tabkey2-mode a buffer local mode.
176 ;; - Add tabkey2-global-mode.
180 ;; - Fix some bugs in customization.
183 ;; - Use invisible-p.
186 ;; - Remove tabkey2-global-mode because of problem with minibuffers.
189 ;; - Add Semantic's smart completion to completion functions.
193 ;; - Add yasnippet and pabbrev completion functions. (Thanks Eric.)
194 ;; - Reorder completion functions.
197 ;; - Add support for pcomplete.
198 ;; - Inform about other key bindings in completion functions list.
199 ;; - Remove no longer used "preferred" from completion functions list.
202 ;; -- Automatically select next function on completion failure.
203 ;; -- Add completion functions reset functions.
206 ;; - Set this-command on call-interactively.
207 ;; - Avoid setting last-command.
210 ;; - Do not complete in or nearby mumamo chunk borders.
211 ;; - Finish completion mode unless last command was a tabkey2 command.
212 ;; - Finish when there are no more active completion functions.
215 ;; - Actually check if completion function is a defined command.
216 ;; - Integrate better with YASnippet.
217 ;; - Give YASnippet higher priority since that seems what is wanted.
220 ;; - Fix bug revealed by 1.36 changes.
223 ;; - Fix typo in completion function list.
224 ;; - Fix corresponding part of check if function is active.
227 ;; - Try first [tab] and then [?\t] when looking for command.
230 ;; - Added Company Mode completion.
232 ;; Fix-me: maybe add \\_>> option to behave like smart-tab. But this
233 ;; will only works for modes that does not do completion of empty
234 ;; words (like in smart-tab).
236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
240 ;; - Maybe problems with comint shell.
241 ;; - Does not check visibility very carefully.
243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
245 ;; This program is free software; you can redistribute it and/or
246 ;; modify it under the terms of the GNU General Public License as
247 ;; published by the Free Software Foundation; either version 2, or
248 ;; (at your option) any later version.
250 ;; This program is distributed in the hope that it will be useful,
251 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
252 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
253 ;; General Public License for more details.
255 ;; You should have received a copy of the GNU General Public License
256 ;; along with this program; see the file COPYING. If not, write to
257 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
258 ;; Floor, Boston, MA 02110-1301, USA.
260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
264 (eval-when-compile (require 'cl))
265 (eval-when-compile (require 'appmenu nil t))
266 (eval-when-compile (require 'mumamo nil t))
268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
272 (defgroup tabkey2 nil
273 "Customization of second tab key press."
277 (defface tabkey2-highlight-line
278 '((t :inherit highlight))
279 "Face for marker on line when default function is active."
282 (defface tabkey2-highlight-line2
283 '((t :inherit isearch-fail))
284 "Face for marker on line when non-default function is active."
287 (defface tabkey2-highlight-message
288 '((t :inherit tabkey2-highlight-line))
289 "Face for messages in echo area."
292 (defface tabkey2-highlight-popup
293 '((default :box t :inherit tabkey2-highlight-message)
294 (((class color) (background light)) :foreground "black")
295 (((class color) (background dark)) :foreground "yellow"))
296 "Face for popup messages."
299 (defcustom tabkey2-show-mark-on-active-line t
300 "Show mark on active line if non-nil.
301 This mark is shown during 'Tab completion state'."
305 (defvar tabkey2-completion-lighter nil)
306 (defcustom tabkey2-completion-lighter-on nil
307 "Mode line lighter for function `tabkey2-completion-state-mode'."
309 :set (lambda (symbol value)
310 (set-default symbol value)
311 (setq tabkey2-completion-lighter (if value " Tab2" nil))
312 (setq minor-mode-alist
313 (assq-delete-all 'tabkey2-completion-state-mode
317 (defcustom tabkey2-show-message-on-enter 2.0
318 "If non-nil show message when entering 'Tab completion state'.
319 If value is a number then delay message that number of seconds."
320 :type '(choice (const :tag "Don't show" nil)
321 (const :tag "Show at once" t)
322 (float :tag "Show, but delayed (seconds)"))
326 ;; (setq tabkey2-message-style 'popup)
327 ;; (setq tabkey2-message-style 'echo-area)
328 (defcustom tabkey2-message-style 'popup
329 "How to show messages."
330 :type '(choice (const :tag "Popup" popup)
331 (const :tag "Echo area" echo-area))
334 (defcustom tabkey2-in-minibuffer nil
335 "If non-nil use command `tabkey2-mode' also in minibuffer."
339 (defcustom tabkey2-in-appmenu t
340 "Show a completion menu in command `appmenu-mode' if t."
342 :set (lambda (sym val)
343 (set-default sym val)
344 (when (fboundp 'appmenu-add)
346 (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu)
347 (appmenu-remove 'tabkey2))))
350 (defun yas/expandable-at-point ()
351 "Return non-nil if a snippet can be expanded here."
352 (when (and (fboundp 'yas/template-condition-predicate)
353 (boundp 'yas/buffer-local-condition))
354 (yas/template-condition-predicate
355 yas/buffer-local-condition)))
357 (defvar tabkey2-company-backends
358 "List of frontends and their backends."
359 '((company-mode (NONE company-abbrev . "Abbrev")
360 (NONE company-css . "CSS")
361 (dabbrev-expan company-dabbrev . "dabbrev for plain text")
362 (NONE company-dabbrev-code . "dabbrev for code")
363 (NONE company-eclim . "eclim (an Eclipse interace)")
364 (lisp-symbol-complete company-elisp . "Emacs Lisp")
365 (complete-tag company-etags . "etags")
366 (NONE company-files . "Files")
367 (NONE company-gtags . "GNU Global")
368 (ispell-complete-word company-ispell . "ispell")
369 (flyspell-correct-word-before-point company-ispell . "ispell")
370 (NONE company-keywords . "Programming language keywords")
371 (nxml-complete company-nxml . "nxml")
372 (NONE company-oddmuse . "Oddmuse")
373 (NONE company-pysmell . "PySmell")
374 (NONE company-ropemacs . "ropemacs")
375 (senator-complete-symbol company-semantic . "CEDET Semantic")
376 (NONE company-tempo . "Tempo templates")
377 (NONE company-xcode . "Xcode"))))
379 (defun tabkey2-find-front-end (fun)
383 (defcustom tabkey2-completion-functions
385 ;; Front ends (should take care of the rest, ie temporary things,
387 ("Company Mode completion" company-complete company-mode)
389 ("Spell check word" flyspell-correct-word-before-point)
391 ("Yasnippet" yas/expand (yas/expandable-at-point))
392 ;; Main mode related, often used
393 ("Semantic Smart Completion" senator-complete-symbol senator-minor-mode)
394 ("Programmable completion" pcomplete)
395 ("nXML completion" nxml-complete)
396 ("Complete Emacs symbol" lisp-complete-symbol)
397 ("Widget complete" widget-complete)
398 ("Comint Dynamic Complete" comint-dynamic-complete)
399 ("PHP completion" php-complete-function)
400 ("Tags completion" complete-tag)
401 ;; General word completion
402 ("Predictive word" complete-word-at-point predictive-mode)
403 ("Predictive abbreviations" pabbrev-expand-maybe)
404 ("Dynamic word expansion" dabbrev-expand nil (setq dabbrev--last-abbrev-location nil))
405 ("Ispell complete word" ispell-complete-word)
407 ("Anything" anything (commandp 'anything))
409 "List of completion functions.
410 The first 'active' entry in this list is normally used during the
411 'Tab completion state' by `tabkey2-complete'. An entry in the
412 list should have either of this forms
414 \(TITLE COMPLETION-FUNCTION ACTIVE-FORM RESET-FORM)
416 TITLE to show in menus etc.
418 COMPLETION-FUNCTION is the completion function symbol.
420 The entry is considered active if the symbol COMPLETION-FUNCTION
421 is bound to a command and
423 - This function has a key binding at point.
427 - The elisp expression ACTIVE-FORM evaluates to non-nil. If it
428 is a single symbol then its variable value is used, otherwise
429 the elisp form is evaled.
431 RESET-FORM is used to reset the completion function before
434 When choosing with `tabkey2-cycle-completion-functions'
435 only the currently active entry in this list are shown."
436 :type '(repeat (list string (choice (command :tag "Currently known command")
437 (symbol :tag "Command not known yet"))
438 (choice (const :tag "Active only if it has a key binding at point" nil)
439 (sexp :tag "Elisp, if evals to non-nil then active"))
440 (sexp :tag "Elisp, reset completion function")))
443 ;; Use emulation mode map for first Tab key
444 (defconst tabkey2-mode-emul-map (make-sparse-keymap)
445 "This keymap just binds tab and alternate key all the time.
446 By default this binds Tab to `tabkey2-first'. The actual keys
447 bound are in `tabkey2-first-key' and `tabkey2-alternate-key'.")
449 (defvar tabkey2--emul-keymap-alist nil)
451 ;; (setq tabkey2-keymap-overlay nil)
452 (defconst tabkey2-completion-state-emul-map
453 (let ((map (make-sparse-keymap)))
454 (define-key map [(control ?c) tab] 'tabkey2-make-current-default)
456 ;;(define-key map tabkey2-alternate-key 'tabkey2-cycle-completion-functions)
457 (define-key map [backtab] 'tabkey2-cycle-completion-functions)
459 (define-key map [(control f1)] 'tabkey2-completion-function-help)
460 (define-key map [(meta f1)] 'tabkey2-show-completion-functions)
461 (define-key map [f1] 'tabkey2-completion-state-help)
463 (define-key map [(control ?g)] 'tabkey2-completion-state-off)
464 (define-key map [tab] 'tabkey2-complete)
466 "This keymap is for `tabkey2-keymap-overlay'.")
468 (defun tabkey2-bind-keys (first-key alternate-key)
469 (let ((mode-map tabkey2-mode-emul-map)
470 (comp-map tabkey2-completion-state-emul-map))
472 (when (and (boundp 'tabkey2-first-key)
474 (define-key mode-map tabkey2-first-key nil))
476 (define-key mode-map first-key 'tabkey2-first))
478 (when (and (boundp 'tabkey2-alternate-key)
479 tabkey2-alternate-key)
480 (define-key mode-map tabkey2-alternate-key nil)
481 (define-key comp-map tabkey2-alternate-key nil))
483 (define-key mode-map alternate-key 'tabkey2-cycle-completion-functions)
484 (define-key comp-map alternate-key 'tabkey2-cycle-completion-functions))
485 (when (and (boundp 'tabkey2-completion-state-mode)
486 tabkey2-completion-state-mode)
487 (tabkey2-completion-state-mode -1)
488 (tabkey2-completion-state-mode 1))))
490 (defcustom tabkey2-first-key [tab]
491 "First key, first time indents, more invocations completes.
492 This key is always bound to `tabkey2-first'."
493 :set (lambda (sym val)
494 (set-default sym val)
497 (when (boundp 'tabkey2-alternate-key)
498 tabkey2-alternate-key)))
502 (defcustom tabkey2-alternate-key [f8]
503 "Alternate key, bound to cycle and show completion functions.
504 This key is always bound to `tabkey2-cycle-completion-functions'."
505 :set (lambda (sym val)
506 (set-default sym val)
507 (tabkey2-bind-keys (when (boundp 'tabkey2-first-key) tabkey2-first-key) val))
511 (tabkey2-bind-keys tabkey2-first-key tabkey2-alternate-key)
514 (define-minor-mode tabkey2-mode
515 "More fun with Tab key number two (completion etc).
516 This global minor mode by default binds Tab in a way that let you
517 do completion with Tab in all buffers \(where it is possible).
519 The Tab key is easy to type on your keyboard. Then why not use
520 it for completion, something that is very useful? Shells usually
521 use Tab for completion so many are used to it. This was the idea
522 of Smart Tabs and this is a generalization of that idea.
524 However in Emacs the Tab key is usually used for indentation.
525 The idea here is that if Tab has been pressed once for
526 indentation, then as long as point stays further Tab keys might
527 as well do completion.
529 So you kind of do Tab-Tab for first completion \(and then just
530 Tab for further completions as long as point is not moved).
532 And there is even kind of Tab-Tab-Tab completion: If completion
533 fails the next completion function will be the one you try with
534 next Tab. \(You get some notification of this, of course.)
536 See `tabkey2-first' for more information about usage.
538 Note: If you do not want the Tab-Tab behaviour above, but still
539 want an easy way to reach the available completion functions,
540 then you can instead of turning on tabkey2-mode enter this in
543 \(global-set-key [f8] 'tabkey2-cycle-completion-functions)
545 After hitting f8 you will then be in the same state as after the
546 first in tabkey2-mode."
552 (add-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
553 (add-hook 'post-command-hook 'tabkey2-post-command)
554 ;; Update emul here if keymap have changed
555 (setq tabkey2--emul-keymap-alist
556 (list (cons 'tabkey2-mode
557 tabkey2-mode-emul-map)))
558 (add-to-list 'emulation-mode-map-alists 'tabkey2--emul-keymap-alist))
559 (tabkey2-completion-state-mode -1)
560 (remove-hook 'post-command-hook 'tabkey2-post-command)
561 (remove-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
562 (setq emulation-mode-map-alists (delq 'tabkey2--emul-keymap-alist
563 emulation-mode-map-alists))))
565 (defcustom tabkey2-modes-that-use-more-tabs
571 custom-mode ;; For Emacs 22
575 "In those modes use must use S-Tab to start completion state.
576 In those modes pressing Tab several types may make sense so you
577 can not go into 'Tab completion state' just because one Tab has
578 been pressed. Instead you use S-Tab to go into that state.
579 After that Tab does completion.
581 You can do use S-Tab in other modes too if you want too."
582 :type '(repeat (choice (command :tag "Currently known command")
583 (symbol :tag "Command not known yet")))
586 (defcustom tabkey2-modes-that-just-complete
590 "Tab is only used for completion in these modes.
591 Therefore `tabkey2-first' just calls the function on Tab."
592 :type '(repeat (choice (command :tag "Currently known command")
593 (symbol :tag "Command not known yet")))
596 ;;(setq tabkey2-use-popup-menus nil)
597 ;; (defcustom tabkey2-use-popup-menus (when (featurep 'popcmp) t)
598 ;; "Use pop menus if available."
602 ;; (defvar tabkey2-preferred nil
603 ;; "Preferred function for second tab key press.")
604 ;; (make-variable-buffer-local 'tabkey2-preferred)
605 ;; (put 'tabkey2-preferred 'permanent-local t)
607 (defvar tabkey2-fallback nil
608 "Fallback function for second tab key press.")
609 (make-variable-buffer-local 'tabkey2-fallback)
610 (put 'tabkey2-fallback 'permanent-local t)
613 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
616 (defvar tabkey2-overlay nil
617 "Show when tab key 2 action is to be done.")
618 (defvar tabkey2-keymap-overlay nil
619 "Hold the keymap for tab key 2.")
621 (defvar tabkey2-current-tab-info nil
622 "Saved information message for Tab completion state.")
623 (defvar tabkey2-current-tab-function nil
624 "Tab completion state current completion function.")
625 (make-variable-buffer-local 'tabkey2-current-tab-function)
627 (defun tabkey2-completion-state-p ()
628 "Return t if Tab completion state should continue.
629 Otherwise return nil."
630 (when (and (eq (current-buffer) (overlay-buffer tabkey2-keymap-overlay))
631 (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window)))
632 (let* ((start (overlay-start tabkey2-keymap-overlay))
633 (end (overlay-end tabkey2-keymap-overlay))
634 (chars (append (buffer-substring-no-properties start end) nil)))
635 (and (not (memq ?\n chars))
636 (not (eq ?\ (car (last chars))))
637 (not (eq ?\ last-input-event))
640 tabkey2-current-tab-function
641 (or (memq this-original-command '(tabkey2-first tabkey2-complete))
642 (let* ((last-name (symbol-name this-original-command))
643 (name-prefix "tabkey2-")
644 (prefix-len (length name-prefix)))
645 (and (> (length last-name) prefix-len)
646 (string= name-prefix (substring last-name 0 prefix-len)))))
649 (defun tabkey2-read-only-p ()
650 "Return non-nil if buffer seems to be read-only at point."
652 (get-char-property (min (+ 0 (point)) (point-max)) 'read-only)
653 (let ((remap (command-remapping 'self-insert-command (point))))
654 (memq remap '(Custom-no-edit)))))
656 ;;;; Minor mode active after first tab
658 (defun tabkey2-get-highlight-face ()
659 (if (eq tabkey2-current-tab-function
660 (tabkey2-first-active-from-completion-functions))
661 'tabkey2-highlight-line
662 'tabkey2-highlight-line2))
664 (defun tabkey2-move-overlays ()
665 "Move overlays that mark the state and carries the state keymap."
666 (let* ((beg (let ((inhibit-field-text-motion t))
667 (line-beginning-position)))
668 (ind (current-indentation))
669 (end (+ beg 1)) ;(if (> ind 0) ind 1)))
670 (inhibit-read-only t))
671 (unless tabkey2-overlay
672 (setq tabkey2-overlay (make-overlay beg end)))
673 ;; Fix-me: gets some strange errors, try avoid moving:
674 (unless (and (eq (current-buffer) (overlay-buffer tabkey2-overlay))
675 (= beg (overlay-start tabkey2-overlay))
676 (= end (overlay-end tabkey2-overlay)))
677 (move-overlay tabkey2-overlay beg end (current-buffer)))
678 ;; Give it a high priority, it is very temporary
679 (overlay-put tabkey2-overlay 'priority 1000)
680 (if tabkey2-show-mark-on-active-line
682 (overlay-put tabkey2-overlay 'face
683 ;;'tabkey2-highlight-line
684 (tabkey2-get-highlight-face)
686 (overlay-put tabkey2-overlay 'help-echo
687 "This highlight shows that Tab completion state is on"))
688 (overlay-put tabkey2-overlay 'face nil)
689 (overlay-put tabkey2-overlay 'help-echo nil)))
690 ;; The keymap overlay
691 (let ((beg (line-beginning-position))
692 (end (line-end-position)))
693 ;;(when (= end (point-max)) (setq end (1+ end)))
697 (unless tabkey2-keymap-overlay
698 ;; Make the rear of the overlay advance so that the keymap works
699 ;; at the end of a line and the end of the buffer.
700 (setq tabkey2-keymap-overlay (make-overlay 0 0 nil nil t)))
701 (overlay-put tabkey2-keymap-overlay 'priority 1000)
702 ;;(overlay-put tabkey2-keymap-overlay 'face 'secondary-selection)
703 (overlay-put tabkey2-keymap-overlay 'keymap
704 tabkey2-completion-state-emul-map)
705 (overlay-put tabkey2-keymap-overlay 'window (selected-window))
706 (move-overlay tabkey2-keymap-overlay beg end (current-buffer))))
708 (defun tabkey2-is-active (fun chk)
709 "Return t FUN is active.
710 Return t if CHK is a symbol with non-nil value or a form that
713 Otherwise return t if FUN has a key binding at point."
714 (when (and (fboundp fun)
716 (or (if (symbolp chk)
717 (when (boundp chk) (symbol-value chk))
719 (let* ((emulation-mode-map-alists
720 ;; Remove keymaps from tabkey2 in this copy:
721 (delq 'tabkey2--emul-keymap-alist
722 (copy-sequence emulation-mode-map-alists)))
723 (keys (tabkey2-symbol-keys fun))
726 (unless (memq (car (append key nil))
731 (defun tabkey2-is-active-p (fun)
732 "Return FUN is active.
733 Look it up in `tabkey2-completion-functions' to find out what to
734 check and return the value from `tabkey2-is-active'."
735 (let ((chk (catch 'chk
736 (dolist (rec tabkey2-completion-functions)
737 (when (eq fun (nth 1 rec))
738 (throw 'chk (nth 2 rec)))))))
739 (tabkey2-is-active fun chk)))
741 (defvar tabkey2-chosen-completion-function nil)
742 (make-variable-buffer-local 'tabkey2-chosen-completion-function)
743 (put 'tabkey2-chosen-completion-function 'permanent-local t)
745 (defun tabkey2-first-active-from-completion-functions ()
746 "Return first active completion function.
747 Look in `tabkey2-completion-functions' for the first function
748 that has an active key binding."
750 (dolist (rec tabkey2-completion-functions)
751 (let ((fun (nth 1 rec))
753 (when (tabkey2-is-active fun chk)
754 (throw 'active-fun fun))))))
756 (defun tabkey2-get-default-completion-fun ()
757 "Return the default completion function.
758 See `tabkey2-first' for the list considered."
759 (or (when (and tabkey2-chosen-completion-function
761 tabkey2-chosen-completion-function))
762 tabkey2-chosen-completion-function)
764 (tabkey2-first-active-from-completion-functions)
767 (defvar tabkey2-overlay-message nil)
769 (defvar tabkey2-completion-state-mode nil)
770 ;;(make-variable-buffer-local 'tabkey2-completion-state-mode)
771 (defun tabkey2-completion-state-mode (arg)
772 "Tab completion state minor mode.
773 This pseudo-minor mode holds the 'Tab completion state'. When this
774 minor mode is on completion key bindings are available.
776 With ARG a positive number turn on, otherwise turn off this minor
779 See `tabkey2-first' for more information."
780 ;;(assq-delete-all 'tabkey2-completion-state-mode minor-mode-alist)
781 (unless (assoc 'tabkey2-completion-state-mode minor-mode-alist)
782 ;;(setq minor-mode-alist (cons '(tabkey2-completion-state-mode " Tab2")
783 (setq minor-mode-alist (cons (list 'tabkey2-completion-state-mode
784 tabkey2-completion-lighter)
786 (let ((emul-map (cdr (car tabkey2--emul-keymap-alist)))
787 (old-wincfg tabkey2-completion-state-mode))
788 (setq tabkey2-completion-state-mode (when (and (numberp arg)
791 (current-window-configuration)
793 (if tabkey2-completion-state-mode
795 ;; Set default completion function
796 (tabkey2-make-message-and-set-fun
797 (tabkey2-get-default-completion-fun))
799 ;;(setq tabkey2-message-is-shown nil)
800 (when tabkey2-show-message-on-enter
801 (tabkey2-show-current-message
802 (when (numberp tabkey2-show-message-on-enter)
803 tabkey2-show-message-on-enter)))
805 (tabkey2-move-overlays)
806 ;; Work around eob keymap problem ...
807 ;;(set-keymap-parent emul-map (overlay-get tabkey2-keymap-overlay
809 ;; Set up for pre/post-command-hook
810 (add-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
811 (add-hook 'post-command-hook 'tabkey2-completion-state-post-command))
812 ;;(set-keymap-parent emul-map nil)
813 (setq tabkey2-current-tab-function nil)
814 (when (and old-wincfg
815 tabkey2-keymap-overlay
816 (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
817 (not (active-minibuffer-window)))
818 (set-window-configuration old-wincfg))
819 (let ((inhibit-read-only t))
820 (when tabkey2-keymap-overlay
821 (delete-overlay tabkey2-keymap-overlay))
822 (when tabkey2-overlay
823 (delete-overlay tabkey2-overlay)))
824 (remove-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
825 (remove-hook 'post-command-hook 'tabkey2-completion-state-post-command)
826 (tabkey2-overlay-message nil)
830 (defun tabkey2-completion-state-off ()
831 "Quit Tab completion state."
833 (tabkey2-completion-state-mode -1)
834 (let ((C-g-binding (or (key-binding [(control ?g)])
835 (key-binding "\C-g")))
837 (when (and (boundp 'company-mode)
839 ;;(message "tabkey2:company-abort")
842 (when (and C-g-binding
843 (not (eq C-g-binding this-command)))
844 ;;(message "tabkey2:c-g=%s" C-g-binding)
845 (call-interactively C-g-binding)
849 (defvar tabkey2-message-is-shown nil)
850 (defun tabkey2-message-is-shown ()
851 (case tabkey2-message-style
853 (when tabkey2-overlay-message
854 (overlay-buffer tabkey2-overlay-message)))
856 (get (current-message) 'tabkey2))))
858 (defun tabkey2-completion-state-pre-command ()
859 "Run this in `pre-command-hook'.
860 Check if message is shown.
861 Remove overlay message.
862 Cancel delayed message."
863 ;;(message "=====> tabkey2-completion-state-pre-command")
866 (setq tabkey2-message-is-shown (tabkey2-message-is-shown))
867 ;;(message "tabkey2-overlay-message=%s, is-shown=%s" tabkey2-overlay-message tabkey2-message-is-shown)
868 (tabkey2-overlay-message nil)
869 (tabkey2-cancel-delayed-message)
870 ;;(message "here buffer=%s, this-command=%s" (current-buffer) this-command)
872 (error (message "tabkey2 pre: %s" (error-message-string err)))))
874 (defun tabkey2-completion-state-post-command ()
875 "Turn off Tab completion state if not feasable any more.
876 This is run in `post-command-hook' after each command."
880 (if (not (tabkey2-completion-state-p))
881 (tabkey2-completion-state-mode -1)
882 ;;(message "tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
883 (tabkey2-move-overlays))
885 (error (message "tabkey2 post: %s" (error-message-string err)))))
887 (defun tabkey2-minibuffer-setup ()
888 "Activate/deactivate function `tabkey2-mode' in minibuffer."
889 (set (make-local-variable 'tabkey2-mode)
891 tabkey2-in-minibuffer))
893 (set (make-local-variable 'emulation-mode-map-alists)
894 (delq 'tabkey2--emul-keymap-alist
895 (copy-sequence emulation-mode-map-alists)))))
898 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
899 ;;;; Message functions
901 ;; Fix-me: Included in Emacs 23.
902 (unless (fboundp 'invisible-p)
903 (defun invisible-p (pos)
904 "Return non-nil if the character after POS is currently invisible."
906 (get-char-property pos 'invisible)))
907 (if (eq buffer-invisibility-spec t)
912 (when (or (memq p buffer-invisibility-spec)
913 (assq p buffer-invisibility-spec))
915 (or (memq prop buffer-invisibility-spec)
916 (assq prop buffer-invisibility-spec)))))))
918 ;; (defun test-scroll ()
920 ;; (setq debug-on-error t)
921 ;; (let* ((buffer-name "test-scroll")
922 ;; (buffer (get-buffer buffer-name)))
923 ;; (when buffer (kill-buffer buffer))
924 ;; (setq buffer (get-buffer-create buffer-name))
925 ;; (switch-to-buffer buffer)
926 ;; (message "here 1") (sit-for 1)
927 ;; (condition-case err
929 ;; (error (message "scroll-up error: %s" err)
931 ;; (message "here 2") (sit-for 1)
933 ;; (message "here 3") (sit-for 1)
936 (defun tabkey2-overlay-message (txt)
937 "Display TXT below or above current line using an overlay."
938 ;;(setq tabkey2-message-is-shown txt)
940 (when tabkey2-overlay-message
941 (delete-overlay tabkey2-overlay-message)
942 (setq tabkey2-overlay-message nil))
943 (let ((ovl tabkey2-overlay-message)
944 (column (current-column))
945 (txt-len (length txt))
953 (unless ovl (setq ovl (make-overlay 0 0)))
954 (when tabkey2-overlay-message
955 (delete-overlay tabkey2-overlay-message))
956 (setq tabkey2-overlay-message ovl)
960 (when (and (/= (point-min) (window-start))
961 (not (pos-visible-in-window-p (min (point-max) (1+ (line-end-position))))))
962 ;; Go back inside window to avoid aggressive scrolling:
966 (forward-line direction)
967 ;; Fix-me: Emacs bug workaround
968 (if (when (< 1 (point))
969 (invisible-p (1- (line-end-position))))
972 (tabkey2-echo-area-message txt))
973 ;; Fix-me: Does this really do anything now:
974 (when (invisible-p (point))
975 (while (invisible-p (point))
976 (forward-line direction)))
977 (setq beg (line-beginning-position))
978 (setq end (line-end-position))
980 (if (or (invisible-p beg) (invisible-p end))
981 ;; Give up, do not fight invisibility:
983 (tabkey2-overlay-message nil)
984 (tabkey2-echo-area-message txt))
987 (move-to-column column)
988 (setq before (buffer-substring beg (point)))
989 (when (< (current-column) column)
992 (make-string (- column (current-column)) ? ))))
993 (setq too-much (- (+ 1 txt-len (length before))
996 (setq before (substring before 0 (- too-much))))
998 (unless (> too-much 0)
999 (move-to-column (+ txt-len (length before)))
1000 (setq after (buffer-substring (point) end)))
1002 (setq ovl-str (concat before
1003 (propertize txt 'face 'tabkey2-highlight-popup)
1007 (overlay-put ovl 'after-string ovl-str)
1008 (overlay-put ovl 'display "")
1009 (overlay-put ovl 'window (selected-window))
1010 (move-overlay ovl beg end (current-buffer)))
1015 ;; Fix-me: This was not usable IMO. Too much flickering.
1016 ;; (defun tabkey2-tooltip (txt)
1017 ;; (let* ((params tooltip-frame-parameters)
1018 ;; (coord (car (point-to-coord (point))))
1019 ;; (left (car coord))
1020 ;; (top (cadr coord))
1021 ;; tooltip-frame-parameters
1023 ;; ;; Fix-me: how do you get char height??
1024 ;; (setq top (+ top 50))
1025 ;; (setq params (tooltip-set-param params 'left left))
1026 ;; (setq params (tooltip-set-param params 'top top))
1027 ;; (setq params (tooltip-set-param params 'top top))
1028 ;; (setq tooltip-frame-parameters params)
1030 ;; (tooltip-show txt nil)))
1032 (defun tabkey2-echo-area-message (txt)
1033 "Show TXT in the echo area with a special face.
1034 Shown with the face `tabkey2-highlight-message'."
1035 (message "%s" (propertize txt
1036 'face 'tabkey2-highlight-message
1039 (defun tabkey2-deliver-message (txt)
1040 "Show message TXT to user."
1041 (case tabkey2-message-style
1042 (popup (tabkey2-overlay-message txt))
1043 (t (tabkey2-echo-area-message txt))))
1045 (defun tabkey2-timer-deliver-message (txt where)
1046 "Show message TXT to user.
1047 Protect from errors cause this is run during a timer."
1048 (save-match-data ;; runs in timer
1049 (when (and tabkey2-completion-state-mode
1050 (equal (point-marker) where))
1052 (tabkey2-deliver-message txt)
1053 (error (message "tabkey2-timer-deliver-message: %s"
1054 (error-message-string err)))))))
1056 (defvar tabkey2-delayed-timer nil)
1058 (defun tabkey2-cancel-delayed-message ()
1059 "Cancel delayed message."
1060 (when tabkey2-delayed-timer
1061 (cancel-timer tabkey2-delayed-timer)
1062 (setq tabkey2-delayed-timer)))
1064 (defun tabkey2-maybe-delayed-message (txt delay)
1065 "Show message TXT, delay it if DELAY is non-nil."
1067 (setq tabkey2-delayed-timer
1068 (run-with-idle-timer
1070 'tabkey2-timer-deliver-message txt (point-marker)))
1071 (tabkey2-deliver-message txt)))
1073 (defun tabkey2-message (delay format-string &rest args)
1074 "Show, if DELAY delayed, otherwise immediately message.
1075 FORMAT-STRING and ARGS are like for `message'."
1076 (let ((txt (apply 'format format-string args)))
1077 (tabkey2-maybe-delayed-message txt delay)))
1079 (defun tabkey2-show-current-message (&optional delay)
1080 "Show current completion message, delayed if DELAY is non-nil."
1081 (tabkey2-cancel-delayed-message)
1082 (tabkey2-message delay "%s" tabkey2-current-tab-info))
1085 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1086 ;;;; Completion function selection etc
1088 (defun tabkey2-symbol-keys (comp-fun)
1089 "Get a list of all key bindings for COMP-FUN."
1090 (let* ((remapped (command-remapping comp-fun)))
1091 (where-is-internal comp-fun
1092 nil ;;overriding-local-map
1095 (defun tabkey2-get-active-completion-functions ()
1096 "Get a list of active completion functions.
1097 Consider only those in `tabkey2-completion-functions'."
1099 (mapcar (lambda (rec)
1100 (let ((fun (nth 1 rec))
1102 (when (tabkey2-is-active fun chk) rec)))
1103 tabkey2-completion-functions)))
1105 (defun tabkey2-make-current-default ()
1106 "Make current Tab completion function default.
1107 Set the current Tab completion function at point as default for
1108 the current buffer."
1113 "Make %s default for Tab completion in current buffer? "
1114 tabkey2-current-tab-function))))
1116 (setq tabkey2-chosen-completion-function
1117 tabkey2-current-tab-function))
1119 (when (local-variable-p 'tabkey2-chosen-completion-function)
1120 (when (y-or-n-p "Use default Tab completion selection in buffer? ")
1122 (kill-local-variable 'tabkey2-chosen-completion-function)))
1123 (when (tabkey2-completion-state-p)
1124 (tabkey2-message nil "%s%s" tabkey2-current-tab-info
1125 (if set-it " - Done" "")))))
1127 (defun tabkey2-activate-next-completion-function (wrap)
1128 (let* ((active (mapcar (lambda (rec)
1130 (tabkey2-get-active-completion-functions)))
1131 (first (car active))
1133 ;;(message "is-shown=%s current=%s active=%s overlay=%s" tabkey2-message-is-shown tabkey2-current-tab-function active tabkey2-overlay)
1134 (when tabkey2-current-tab-function
1135 (while (and active (not next))
1136 (when (eq (car active) tabkey2-current-tab-function)
1137 (setq next (cadr active)))
1138 (setq active (cdr active))))
1140 (when wrap (setq next first)))
1141 ;;(if (eq first next)
1142 (tabkey2-make-message-and-set-fun next)))
1144 (defun tabkey2-cycle-completion-functions (prefix)
1145 "Cycle through cnd display ompletion functions.
1146 If 'Tab completion state' is not on then turn it on.
1148 If PREFIX is given just show what this command will do."
1150 (if (tabkey2-read-only-p)
1151 (message "Buffer is read only at point")
1152 (unless tabkey2-completion-state-mode (tabkey2-completion-state-mode 1))
1156 (message "(TabKey2) %s: show/cycle completion function"
1158 (when tabkey2-message-is-shown
1159 ;; Message is shown currently so change
1160 (tabkey2-activate-next-completion-function 'wrap))
1161 (tabkey2-show-current-message)))))
1164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1165 ;;;; Handling of Tab and alternate key
1168 (defun tabkey2-emma-without-tabkey2 ()
1169 ;; Remove keymaps from tabkey2 in this copy:
1170 (delq 'tabkey2--emul-keymap-alist
1171 (copy-sequence emulation-mode-map-alists)))
1173 (defvar tabkey2-step-out-of-the-way nil)
1174 ;;(remove-hook 'pre-command-hook 'tabkey2-pre-command)
1175 ;;(remove-hook 'post-command-hook 'tabkey2-pre-command)
1176 ;;(remove-hook 'post-command-hook 'tabkey2-post-command-2)
1177 (defun tabkey2-post-command ()
1178 (setq tabkey2-step-out-of-the-way nil)
1181 (when (and (boundp 'company-overriding-keymap-bound) company-overriding-keymap-bound)
1182 (setq tabkey2-step-out-of-the-way
1183 (let ((emulation-mode-map-alists (tabkey2-emma-without-tabkey2)))
1184 (key-binding (this-command-keys))))
1185 ;;(message "tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
1187 (error "tabkey2-pre-command: %s" err)))
1188 ;; (and (boundp 'company-preview-overlay)
1189 ;; (or company-preview-overlay
1190 ;; company-pseudo-tooltip-overlay)))
1191 (defun tabkey2-first (prefix)
1192 "Do something else after first Tab.
1193 This function is bound to the Tab key \(or whatever key
1194 `tabkey2-first-key' is) when minor mode command `tabkey2-mode' is
1195 on. It works like this:
1197 1. The first time Tab is pressed do whatever Tab would have done
1198 if minor mode command `tabkey2-mode' was off.
1200 Then before next command enter a new temporary 'Tab completion
1201 state' for just the next command. Show this by a highlight on
1202 the indentation and a marker \"Tab2\" in the mode line.
1205 - the minibuffer is active and `tabkey2-in-minibuffer' is nil
1206 - `major-mode' is in `tabkey2-modes-that-use-more-tabs' then
1207 do not enter this temporary 'Tab completion state'.
1209 For major modes where it make sense to press Tab several times
1210 you can use `tabkey2-alternate-key' to enter 'Tab completion
1214 2. As long as point is not move do completion when Tab is pressed
1215 again. Show that this state is active with a highlighting at
1216 the line beginning, a marker on the mode line (Tab2) and a
1217 message in the echo area which tells what kind of completion
1220 When deciding what kind of completion to do look in the table
1221 below and do whatever it found first that is not nil:
1223 - `tabkey2-preferred'
1224 - `tabkey2-completion-functions'
1225 - `tabkey2-fallback'
1227 3. Of course, there must be some way for you to easily determine
1228 what kind of completion because there are many in Emacs. If
1229 you do not turn it off this function will show that to you.
1230 And if you turn it off you can still display it, see the key
1233 If this function is used with a PREFIX argument then it just
1234 shows what Tab will do.
1236 If the default kind of completion is not what you want then
1237 you can choose completion function from any of the candidates
1238 in `tabkey2-completion-functions'. During the 'Tab completion
1239 state' the following extra key bindings are available:
1241 \\{tabkey2-completion-state-emul-map}
1243 Of course, some languages does not have a fixed indent as is
1244 assumed above. You can put major modes for those in
1245 `tabkey2-modes-that-just-complete'.
1247 Some major modes uses tab for something else already. Those are
1248 in `tabkey2-modes-that-use-more-tabs'. There is an alternate
1249 key, `tabkey2-alternate-key' if you want to do completion
1250 there. Note that this key does not do completion. It however
1251 enters 'Tab completion state' in which you have access to the
1252 keys above for completion etc. \(This key also lets you cycle
1253 through the completion functions too choose which one to use.)
1256 NOTE: This uses `emulation-mode-map-alists' and it supposes that
1257 nothing else is bound to Tab there."
1259 ;;(message "first:tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
1260 (if tabkey2-step-out-of-the-way
1262 (message "step-out=%s" tabkey2-step-out-of-the-way)
1263 (call-interactively tabkey2-step-out-of-the-way))
1264 (if (and tabkey2-keymap-overlay
1265 (eq (overlay-buffer tabkey2-keymap-overlay) (current-buffer))
1266 (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
1267 (>= (point) (overlay-start tabkey2-keymap-overlay))
1268 (<= (point) (overlay-end tabkey2-keymap-overlay)))
1269 ;; We should maybe not be here, but the keymap does not work at
1270 ;; the end of the buffer so we call the second tab function from
1272 (if (memq 'shift (event-modifiers last-input-event))
1273 (call-interactively 'tabkey2-cycle-completion-functions)
1274 (call-interactively 'tabkey2-complete prefix))
1275 (let* ((emma-without-tabkey2 (tabkey2-emma-without-tabkey2))
1276 (at-word-end (looking-at "\\_>"))
1277 (just-complete (or (memq major-mode tabkey2-modes-that-just-complete)
1279 (what (if just-complete
1281 (if (or (unless tabkey2-in-minibuffer
1282 (active-minibuffer-window))
1283 (when (fboundp 'use-region-p) (use-region-p))
1285 (memq major-mode tabkey2-modes-that-use-more-tabs))
1289 (to-do-1 (unless (or
1290 ;; Skip action on tab if shift tab,
1291 ;; backtab or a mode in the "just
1293 (memq 'shift (event-modifiers last-input-event))
1294 (equal [backtab] (this-command-keys-vector))
1296 (let ((emulation-mode-map-alists emma-without-tabkey2))
1297 ;; Fix-me: Is this the way to pick up "tab keys"?
1298 (or (key-binding [tab] t)
1299 (key-binding [?\t] t))
1301 (to-do-2 (unless (or ;;(memq what '(complete))
1302 (memq what '(indent))
1303 (memq to-do-1 '(widget-forward button-forward)))
1304 (tabkey2-get-default-completion-fun))))
1305 ;;(message "step-out-of-the-way=%s to-do=%s/%s, emmaa-without-tabkey2=%s" step-out-of-the-way to-do-1 to-do-2 emma-without-tabkey2)
1307 (if (memq 'shift (event-modifiers last-input-event))
1309 "(TabKey2) First shift %s: turn on 'Tab completion state'"
1311 (message "(TabKey2) First %s: %s, next: maybe %s"
1312 last-input-event to-do-1
1313 (if to-do-2 to-do-2 "(same)")))
1315 (let (xmumamo-multi-major-mode)
1316 (tabkey2-call-interactively to-do-1)))
1317 (unless (tabkey2-read-only-p)
1319 (tabkey2-completion-state-mode 1))))))))
1321 (defun tabkey2-call-interactively (function)
1322 "Like `call-interactively, but handle `this-command'."
1323 (setq this-command function)
1324 (call-interactively function))
1326 (defcustom tabkey2-choose-next-on-error t
1327 "Choose next completion function on error."
1331 (defun tabkey2-complete (prefix)
1332 "Call current completion function.
1333 If used with a PREFIX argument then just show what Tab will do."
1335 (if (and (boundp 'mumamo-multi-major-mode)
1336 mumamo-multi-major-mode
1337 (not (mumamo-syntax-maybe-completable (point))))
1338 (message "Please move out of chunk border before trying to complete.")
1340 (message "(TabKey2) %s: %s"
1341 last-input-event tabkey2-current-tab-function)
1342 (let ((here (point))
1343 (res (if tabkey2-choose-next-on-error
1345 (tabkey2-call-interactively tabkey2-current-tab-function)
1346 (error (message "%s" (error-message-string err))
1348 (tabkey2-call-interactively tabkey2-current-tab-function))))
1349 (when (and (not res) (= here (point)))
1350 (tabkey2-activate-next-completion-function nil)
1351 ;;(message "complete.tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
1352 (if tabkey2-current-tab-function
1353 (tabkey2-show-current-message)
1354 (message "No more active completion functions in this buffer")))))))
1356 ;; Fix-me: I am not sure that it really is useful with a globalized
1357 ;; minor mode here because there are so many other ways to control
1358 ;; what happens in a specific buffer. Maybe it would just be
1361 ;; If found another problem with making it globalized: tabkey2-mode
1362 ;; uses emulation-mode-map-alist. I decided to remove this therefore.
1364 ;; (defun tabkey2-turn-on ()
1365 ;; "Turn on `tabkey2-mode' in current buffer."
1366 ;; (tabkey2-mode 1))
1368 ;; (defvar tabkey2-turn-on-function 'tabkey2-turn-on
1369 ;; "Function used to mabye turn on `tabkey2-mode' in current-buffer.
1370 ;; This function is used by `tabkey2-global-mode' to turn on
1371 ;; `tabkey2-mode'.")
1373 ;; (defun tabkey2-turn-on-in-buffer ()
1374 ;; (funcall tabkey2-turn-on-function))
1376 ;; (define-globalized-minor-mode tabkey2-global-mode
1377 ;; tabkey2-mode tabkey2-turn-on-in-buffer)
1379 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1382 (defun tabkey2-show-completion-state-help ()
1383 "Help for 'Tab completion state'.
1384 To get out of this state you can move out of the current line.
1386 During this state the keymap below is active. This state stops
1387 as soon as you leave the current row.
1389 \\{tabkey2-completion-state-emul-map}
1390 See function `tabkey2-mode' for more information.
1392 If you want to use Emacs normal help function then press F1
1395 (defun tabkey2-completion-state-help ()
1396 "Show help for 'Tab completion state'."
1398 ;;(message "tckv=%s" (this-command-keys-vector)) ;;(sit-for 1)
1399 ;; Fix-me: There seems to be an Emacs bug lurking here. Sometimes
1400 ;; invoked-by-f1 is not [f1].
1401 (let ((invoked-by-f1 (equal (this-command-keys-vector) [f1]))
1403 ;;(message "invoked-by-f1=%s" invoked-by-f1) ;; fix-me
1404 (if (not invoked-by-f1)
1405 (describe-function 'tabkey2-show-completion-state-help)
1409 (concat "Type a key for Emacs help."
1410 " Or, wait for Tab completion state help: ")
1416 ;;(message "Tab completion state help")
1417 (describe-function 'tabkey2-show-completion-state-help))
1419 (call-interactively 'describe-key-briefly))
1421 (call-interactively 'describe-key))
1423 (tabkey2-completion-state-mode -1)
1424 (setq unread-command-events
1428 (append (this-command-keys) nil)))))))))
1430 (defun tabkey2-completion-function-help ()
1431 "Show help for current completion function."
1433 (describe-function tabkey2-current-tab-function))
1438 (defun tabkey2-get-key-binding (fun t2)
1439 "Get key binding for FUN during 'Tab completion state'."
1440 (let* ((remapped (command-remapping fun))
1441 (key (where-is-internal fun
1442 (when t2 tabkey2-completion-state-emul-map)
1448 ;; (defun tabkey2-reset-completion-function (comp-fun)
1449 ;; "Reset states for functions in `tabkey2-completion-functions'."
1450 ;; ;; Fix-me: remove hard-coding
1451 ;; (setq dabbrev--last-abbrev-location nil))
1453 (defun tabkey2-make-message-and-set-fun (comp-fun)
1454 "Set current completion function to COMP-FUN.
1455 Build message but don't show it."
1456 ;;(tabkey2-reset-completion-functions)
1457 (let* ((chs-fun 'tabkey2-cycle-completion-functions)
1458 (key (tabkey2-get-key-binding chs-fun t))
1459 ;;(def-fun (tabkey2-get-default-completion-fun))
1461 (comp-fun-key (tabkey2-get-key-binding comp-fun nil))
1463 (setq tabkey2-current-tab-function comp-fun)
1464 (dolist (rec tabkey2-completion-functions)
1465 (let ((fun (nth 1 rec))
1468 (when (eq fun comp-fun)
1471 (let ((info (concat (format "Tab: %s" what)
1473 (format " (%s)" (key-description comp-fun-key))
1475 (if (cdr (tabkey2-get-active-completion-functions))
1476 (format ", other %s, help F1"
1477 (key-description key))
1479 (setq tabkey2-current-tab-info info))))
1481 (defun tabkey2-get-active-string (bnd fun buf)
1482 "Get string to show for state.
1487 (if (with-current-buffer buf (tabkey2-read-only-p))
1488 (propertize "active, but read-only" 'face '( :foreground "red"))
1489 (propertize "active" 'face '( :foreground "green3")))
1490 (if (and (fboundp fun)
1492 (propertize "not active" 'face '( :foreground "red2"))
1493 (propertize "not defined" 'face '( :foreground "gray")))))
1495 (defun tabkey2-show-completion-functions ()
1496 "Show what currently may be used for completion."
1498 (let ((orig-buf (current-buffer))
1500 (active-mark (concat " "
1501 (propertize "<= default"
1502 'face '( :background "yellow"))))
1504 (chosen-fun tabkey2-chosen-completion-function)
1508 (dolist (rec tabkey2-completion-functions)
1509 (let ((fun (nth 1 rec))
1511 (when (eq fun chosen-fun) (setq what txt))))
1512 (setq chosen (list what chosen-fun)))
1513 (with-output-to-temp-buffer (help-buffer)
1514 (help-setup-xref (list #'tabkey2-show-completion-functions)
1516 (with-current-buffer (help-buffer)
1517 (insert (concat "The completion functions available for"
1518 " 'Tab completion' in buffer\n'"
1519 (buffer-name orig-buf)
1520 "' at point with mode " orig-mn " are shown below.\n"
1521 "The first active function is used by default.\n\n"))
1523 (insert " No completion function is set as default.")
1524 (let* ((txt (nth 0 chosen))
1525 (fun (nth 1 chosen))
1526 (chk (nth 2 chosen))
1527 (bnd (with-current-buffer orig-buf
1528 (tabkey2-is-active fun chk)))
1529 (act (tabkey2-get-active-string bnd fun orig-buf)))
1530 (insert (format " Default is set to\n %s (%s): %s"
1532 (when bnd (insert active-mark) (setq act-found t))))
1534 ;;; (if (not tabkey2-preferred)
1535 ;;; (insert " None is preferred")
1536 ;;; (let* ((txt (nth 0 tabkey2-preferred))
1537 ;;; (fun (nth 1 tabkey2-preferred))
1538 ;;; (chk (nth 2 chosen))
1539 ;;; (bnd (with-current-buffer orig-buf
1540 ;;; (tabkey2-is-active fun chk)))
1541 ;;; (act (tabkey2-get-active-string bnd fun orig-buf)))
1542 ;;; (insert (format " Preferred is %s (`%s')': %s"
1544 ;;; (when bnd (insert active-mark) (setq act-found t))))
1546 (dolist (comp-fun tabkey2-completion-functions)
1547 (let* ((txt (nth 0 comp-fun))
1548 (fun (nth 1 comp-fun))
1549 (chk (nth 2 comp-fun))
1550 (bnd (with-current-buffer orig-buf
1551 (tabkey2-is-active fun chk)))
1552 (act (tabkey2-get-active-string bnd fun orig-buf))
1553 (keys (where-is-internal fun)))
1556 (setq keys (mapconcat 'key-description keys ", "))
1557 (when (and (< 9 (length keys))
1558 (string= "<menu-bar>" (substring keys 0 10)))
1560 (setq keys (propertize keys 'face 'highlight))
1561 (setq keys (concat ", " keys))
1567 (when (and (not act-found) bnd)
1568 (insert active-mark) (setq act-found t))
1571 (if (not tabkey2-fallback)
1572 (insert " There is no fallback")
1573 (let* ((txt (nth 0 tabkey2-fallback))
1574 (fun (nth 1 tabkey2-fallback))
1575 (chk (nth 2 tabkey2-fallback))
1576 (bnd (with-current-buffer orig-buf
1577 (tabkey2-is-active fun chk)))
1578 (act (tabkey2-get-active-string bnd fun orig-buf)))
1579 (insert (format " Fallback is %s (`%s'): %s"
1581 (when (and (not act-found) bnd)
1582 (insert active-mark)
1583 (setq act-found t))))
1584 (insert "\n\nYou an ")
1585 (insert-text-button "customize this list"
1586 'action (lambda (button)
1588 'tabkey2-completion-functions)))
1589 (insert ".\nSee function `tabkey2-mode' for more information.")
1590 (with-no-warnings (print-help-return-message))))))
1592 (defvar tabkey2-completing-read 'completing-read)
1594 (defun tabkey2-set-fun (fun)
1595 "Use function FUN for Tab in 'Tab completion state'."
1596 (setq tabkey2-chosen-completion-function fun)
1598 (setq fun (tabkey2-first-active-from-completion-functions)))
1599 (tabkey2-make-message-and-set-fun fun)
1600 (when (tabkey2-completion-state-p)
1601 (message "%s" tabkey2-current-tab-info)))
1603 (defun tabkey2-appmenu ()
1604 "Make a menu for minor mode command `appmenu-mode'."
1605 (unless (tabkey2-read-only-p)
1606 (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
1608 (map (make-sparse-keymap tit)))
1609 (define-key map [tabkey2-usage]
1610 (list 'menu-item "Show Available Completion Functions for TabKey2"
1611 'tabkey2-show-completion-functions))
1612 (define-key map [tabkey2-divider-1] (list 'menu-item "--"))
1613 (let ((set-map (make-sparse-keymap "Set Completion")))
1614 (define-key map [tabkey2-choose]
1615 (list 'menu-item "Set Primary TabKey2 Tab Completion in Buffer" set-map))
1616 (dolist (cf-rec cf-r)
1617 (let ((dsc (nth 0 cf-rec))
1618 (fun (nth 1 cf-rec)))
1620 (vector (intern (format "tabkey2-set-%s" fun)))
1621 (list 'menu-item dsc
1624 (tabkey2-set-fun ',fun))
1627 . (eq ',fun tabkey2-chosen-completion-function))))))
1628 (define-key set-map [tabkey2-set-div] (list 'menu-item "--"))
1629 (define-key set-map [tabkey2-set-default]
1630 (list 'menu-item "Default Tab completion"
1633 (tabkey2-set-fun nil))
1635 '(:radio . (null tabkey2-chosen-completion-function))))
1636 (define-key set-map [tabkey2-set-header-div] (list 'menu-item "--"))
1637 (define-key set-map [tabkey2-set-header]
1638 (list 'menu-item "Set Primary Tab Completion for Buffer"))
1640 (define-key map [tabkey2-divider] (list 'menu-item "--"))
1641 (dolist (cf-rec cf-r)
1642 (let ((dsc (nth 0 cf-rec))
1643 (fun (nth 1 cf-rec)))
1645 (vector (intern (format "tabkey2-call-%s" fun)))
1646 (list 'menu-item dsc fun
1649 . (eq ',fun tabkey2-chosen-completion-function))
1653 ;; (defun tabkey2-completion-menu-popup ()
1654 ;; "Pop up a menu with completion alternatives."
1656 ;; (let ((menu (tabkey2-appmenu)))
1657 ;; (popup-menu-at-point menu)))
1659 ;; (defun tabkey2-choose-completion-function ()
1660 ;; "Set current completion function.
1661 ;; Let user choose completion function from those in
1662 ;; `tabkey2-completion-functions' that have some key binding at
1665 ;; Let the chosen completion function be the default for subsequent
1666 ;; completions in the current buffer."
1667 ;; ;; Fix-me: adjust to mumamo.
1670 ;; (if (and (featurep 'popcmp)
1671 ;; tabkey2-use-popup-menus)
1672 ;; (tabkey2-completion-menu-popup)
1673 ;; (when (eq 'completing-read tabkey2-completing-read) (isearch-unread 'tab))
1674 ;; (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
1675 ;; (cf (cons '("- Use default Tab completion" nil) cf-r))
1676 ;; (hist (mapcar (lambda (rec)
1679 ;; (tit (funcall tabkey2-completing-read "Set current completion function: " cf
1681 ;; t ;; require-match
1682 ;; nil ;; initial-input
1685 ;; (fun-rec (assoc-string tit cf))
1686 ;; (fun (cadr fun-rec)))
1687 ;; (setq tabkey2-chosen-completion-function fun)
1689 ;; (setq fun (tabkey2-first-active-from-completion-functions)))
1690 ;; (tabkey2-make-message-and-set-fun fun)
1691 ;; (when (tabkey2-completion-state-p)
1692 ;; (tabkey2-show-current-message))))))
1694 ;; (defun tabkey2-add-to-appmenu ()
1695 ;; "Add a menu to function `appmenu-mode'."
1696 ;; (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu))
1700 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1701 ;;; tabkey2.el ends here