1702 lines
65 KiB
EmacsLisp
1702 lines
65 KiB
EmacsLisp
|
;;; tabkey2.el --- Use second tab key pressed for what you want
|
||
|
|
;;
|
||
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
||
|
|
;; Created: 2008-03-15
|
||
|
|
(defconst tabkey2:version "1.40")
|
||
|
|
;; Last-Updated: 2009-07-15 Wed
|
||
|
|
;; URL: http://www.emacswiki.org/cgi-bin/wiki/tabkey2.el
|
||
|
|
;; Keywords:
|
||
|
|
;; Compatibility:
|
||
|
|
;;
|
||
|
|
;; Features that might be required by this library:
|
||
|
|
;;
|
||
|
|
;; `appmenu', `cl'.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Commentary:
|
||
|
|
;;
|
||
|
|
;; The tab key is in Emacs often used for indentation. However if you
|
||
|
|
;; press the tab key a second time and Emacs tries to do indentation
|
||
|
|
;; again, then usually nothing exciting will happen. Then why not use
|
||
|
|
;; second tab key in a row for something else?
|
||
|
|
;;
|
||
|
|
;; Commonly used completion functions in Emacs is often bound to
|
||
|
|
;; something corresponding to Alt-Tab. Unfortunately this is unusable
|
||
|
|
;; if you have a window manager that have an apetite for it (like that
|
||
|
|
;; on MS Windows for example, and several on GNU/Linux).
|
||
|
|
;;
|
||
|
|
;; Then using the second tab key press for completion might be a good
|
||
|
|
;; choice and perhaps also easy to remember.
|
||
|
|
;;
|
||
|
|
;; This little library tries to make it easy to do use the second tab
|
||
|
|
;; press for completion. Or you can see this library as a swizz army
|
||
|
|
;; knife for the tab key ;-)
|
||
|
|
;;
|
||
|
|
;; See `tabkey2-mode' for more information.
|
||
|
|
;;
|
||
|
|
;;
|
||
|
|
;; This is a generalized of an idea Sebastien Rocca Serra once
|
||
|
|
;; presented on Emacs Wiki and called "Smart Tab". (It seems like
|
||
|
|
;; many others have also been using Tab for completion in one way or
|
||
|
|
;; another for years.)
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Change log:
|
||
|
|
;;
|
||
|
|
;; Version 1.04:
|
||
|
|
;; - Add overlay to display state after first tab.
|
||
|
|
;;
|
||
|
|
;; Version 1.05:
|
||
|
|
;; - Fix remove overlay problem.
|
||
|
|
;;
|
||
|
|
;; Version 1.06:
|
||
|
|
;; - Add completion function choice.
|
||
|
|
;; - Add support for popcmp popup completion.
|
||
|
|
;;
|
||
|
|
;; Version 1.07:
|
||
|
|
;; - Add informational message after first tab.
|
||
|
|
;;
|
||
|
|
;; Version 1.08:
|
||
|
|
;; - Give better informational message after first tab.
|
||
|
|
;;
|
||
|
|
;; Version 1.09:
|
||
|
|
;; - Put flyspell first.
|
||
|
|
;;
|
||
|
|
;; Version 1.09:
|
||
|
|
;; - Give the overlay higher priority.
|
||
|
|
;;
|
||
|
|
;; Version 1.10:
|
||
|
|
;; - Correct tabkey2-completion-functions.
|
||
|
|
;; - Add double-tab for modes where tab can not be typed again.
|
||
|
|
;; - Use better condition for when completion can be done, so that it
|
||
|
|
;; can be done later while still on the same line.
|
||
|
|
;; - Add a better message handling for the "Tab completion state".
|
||
|
|
;; - Add C-g break out of the "Tab completion state".
|
||
|
|
;; - Add faces for highlight.
|
||
|
|
;; - Make it work in custom mode buffers.
|
||
|
|
;; - Fix documentation for `tabkey2-first'
|
||
|
|
;;
|
||
|
|
;; Version 1.11:
|
||
|
|
;; - Don't call chosen completion function directly. Instead make it
|
||
|
|
;; default for current buffer.
|
||
|
|
;;
|
||
|
|
;; Version 1.12:
|
||
|
|
;; - Simplify code.
|
||
|
|
;; - Add help to C-f1 during "Tab completion state".
|
||
|
|
;; - Fix documentation basics.
|
||
|
|
;; - Add customization of state message and line marking.
|
||
|
|
;; - Fix handling of double-Tab modes.
|
||
|
|
;; - Make user interaction better.
|
||
|
|
;; - Handle read-only in custom buffers better.
|
||
|
|
;; - Add more flexible check for if completion function is active.
|
||
|
|
;; - Support predictive mode.
|
||
|
|
;; - Reorder and simplify.
|
||
|
|
;;
|
||
|
|
;; Version 1.13:
|
||
|
|
;; - Add org-mode to the double-tab gang.
|
||
|
|
;; - Make it possible to use double-tab in normal buffers.
|
||
|
|
;; - Add cycling through completion functions to S-tab.
|
||
|
|
;;
|
||
|
|
;; Version 1.14:
|
||
|
|
;; - Fix bug in handling of read-only.
|
||
|
|
;; - Show completion binding in help message.
|
||
|
|
;; - Add binding to make current choice buffer local when cycling.
|
||
|
|
;;
|
||
|
|
;; Version 1.15:
|
||
|
|
;; - Fix problem at buffer end.
|
||
|
|
;; - Add S-tab to enter completion state without indentation.
|
||
|
|
;; - Add backtab bindings too for this.
|
||
|
|
;; - Remove double-tab, S-tab is better.
|
||
|
|
;; - Add list of modes that uses more tabs.
|
||
|
|
;; - Add list of modes that uses tab only for completion.
|
||
|
|
;; - Move first overlay when indentation changes.
|
||
|
|
;; - Make mark at line beginning 1 char long.
|
||
|
|
;;
|
||
|
|
;; Version 1.16:
|
||
|
|
;; - Don't call tab function when alternate key is pressed.
|
||
|
|
;;
|
||
|
|
;; Version 1.17:
|
||
|
|
;; - Let alternate key cycle completion functions instead of complete.
|
||
|
|
;; - Bind backtab.
|
||
|
|
;; - Fix bug when only one completion funciton was available.
|
||
|
|
;; - Fix bug when alt key and major without fix indent.
|
||
|
|
;;
|
||
|
|
;; Version 1.18:
|
||
|
|
;; - Add popup style messages.
|
||
|
|
;; - Add delay to first message.
|
||
|
|
;; - Use different face for indicator on line and message.
|
||
|
|
;; - Use different face for echo area and popup messages.
|
||
|
|
;; - Add anything to completion functions.
|
||
|
|
;; - Put help funciton on f1.
|
||
|
|
;; - Always bind alternate key to cycle.
|
||
|
|
;; - Change defcustoms to simplify (excuse me).
|
||
|
|
;; - Work around end of buffer problems.
|
||
|
|
;; - Work around start of buffer problems.
|
||
|
|
;; - Assure popup messages are visible.
|
||
|
|
;; - Reorder code in more logical order.
|
||
|
|
;;
|
||
|
|
;; Version 1.19:
|
||
|
|
;; - Make overlay keymap end advance.
|
||
|
|
;; - Remove overlay keymap parent.
|
||
|
|
;;
|
||
|
|
;; Version 1.20:
|
||
|
|
;; - Fix bug on emtpy line.
|
||
|
|
;; - Fix some text problems.
|
||
|
|
;; - Make f1 c/k work in tab completion state.
|
||
|
|
;;
|
||
|
|
;; Version 1.20:
|
||
|
|
;; - Fixed bug in overlay removal.
|
||
|
|
;;
|
||
|
|
;; Version 1.21:
|
||
|
|
;; - Fixed bug in minibuffer setup.
|
||
|
|
;;
|
||
|
|
;; Version 1.22:
|
||
|
|
;; - Honour widget-forward, button-forward.
|
||
|
|
;;
|
||
|
|
;; Version 1.23:
|
||
|
|
;; - Remove binding of shift tab.
|
||
|
|
;; - Check if use-region-p is defined.
|
||
|
|
;;
|
||
|
|
;; Version 1.24:
|
||
|
|
;; - Add option for completion state mode line marker.
|
||
|
|
;; - Fix bug in tabkey2-show-completion-functions.
|
||
|
|
;; - Move off completion point cancels completion state.
|
||
|
|
;; - Fix bugs in help.
|
||
|
|
;; - Try to fix some problems with invisible text, at least in
|
||
|
|
;; org-mode.
|
||
|
|
;; - Restore window config, completions often leaves without.
|
||
|
|
;;
|
||
|
|
;; Version 1.25:
|
||
|
|
;; - Fix bug in tabkey2-completion-state-p.
|
||
|
|
;;
|
||
|
|
;; Version 1.26:
|
||
|
|
;; - Make tabkey2-mode a buffer local mode.
|
||
|
|
;; - Add tabkey2-global-mode.
|
||
|
|
;; - Fix some bugs.
|
||
|
|
;;
|
||
|
|
;; Version 1.27:
|
||
|
|
;; - Fix some bugs in customization.
|
||
|
|
;;
|
||
|
|
;; Version 1.28:
|
||
|
|
;; - Use invisible-p.
|
||
|
|
;;
|
||
|
|
;; Version 1.29:
|
||
|
|
;; - Remove tabkey2-global-mode because of problem with minibuffers.
|
||
|
|
;;
|
||
|
|
;; Version 1.30:
|
||
|
|
;; - Add Semantic's smart completion to completion functions.
|
||
|
|
;; (Thanks Eric.)
|
||
|
|
;;
|
||
|
|
;; Version 1.31:
|
||
|
|
;; - Add yasnippet and pabbrev completion functions. (Thanks Eric.)
|
||
|
|
;; - Reorder completion functions.
|
||
|
|
;;
|
||
|
|
;; Version 1.32:
|
||
|
|
;; - Add support for pcomplete.
|
||
|
|
;; - Inform about other key bindings in completion functions list.
|
||
|
|
;; - Remove no longer used "preferred" from completion functions list.
|
||
|
|
;;
|
||
|
|
;; Version 1.33:
|
||
|
|
;; -- Automatically select next function on completion failure.
|
||
|
|
;; -- Add completion functions reset functions.
|
||
|
|
;;
|
||
|
|
;; Version 1.34:
|
||
|
|
;; - Set this-command on call-interactively.
|
||
|
|
;; - Avoid setting last-command.
|
||
|
|
;;
|
||
|
|
;; Version 1.35:
|
||
|
|
;; - Do not complete in or nearby mumamo chunk borders.
|
||
|
|
;; - Finish completion mode unless last command was a tabkey2 command.
|
||
|
|
;; - Finish when there are no more active completion functions.
|
||
|
|
;;
|
||
|
|
;; Version 1.36:
|
||
|
|
;; - Actually check if completion function is a defined command.
|
||
|
|
;; - Integrate better with YASnippet.
|
||
|
|
;; - Give YASnippet higher priority since that seems what is wanted.
|
||
|
|
;;
|
||
|
|
;; Version 1.37:
|
||
|
|
;; - Fix bug revealed by 1.36 changes.
|
||
|
|
;;
|
||
|
|
;; Version 1.38:
|
||
|
|
;; - Fix typo in completion function list.
|
||
|
|
;; - Fix corresponding part of check if function is active.
|
||
|
|
;;
|
||
|
|
;; Version 1.39:
|
||
|
|
;; - Try first [tab] and then [?\t] when looking for command.
|
||
|
|
;;
|
||
|
|
;; Version 1.40:
|
||
|
|
;; - Added Company Mode completion.
|
||
|
|
;;
|
||
|
|
;; Fix-me: maybe add \\_>> option to behave like smart-tab. But this
|
||
|
|
;; will only works for modes that does not do completion of empty
|
||
|
|
;; words (like in smart-tab).
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Known bugs
|
||
|
|
;;
|
||
|
|
;; - Maybe problems with comint shell.
|
||
|
|
;; - Does not check visibility very carefully.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;; This program is free software; you can redistribute it and/or
|
||
|
|
;; modify it under the terms of the GNU General Public License as
|
||
|
|
;; published by the Free Software Foundation; either version 2, or
|
||
|
|
;; (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This program is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
|
|
;; General Public License for more details.
|
||
|
|
;;
|
||
|
|
;; You should have received a copy of the GNU General Public License
|
||
|
|
;; along with this program; see the file COPYING. If not, write to
|
||
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
(eval-when-compile (require 'cl))
|
||
|
|
(eval-when-compile (require 'appmenu nil t))
|
||
|
|
(eval-when-compile (require 'mumamo nil t))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;;; Custom
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defgroup tabkey2 nil
|
||
|
|
"Customization of second tab key press."
|
||
|
|
:group 'nxhtml
|
||
|
|
:group 'convenience)
|
||
|
|
|
||
|
|
(defface tabkey2-highlight-line
|
||
|
|
'((t :inherit highlight))
|
||
|
|
"Face for marker on line when default function is active."
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defface tabkey2-highlight-line2
|
||
|
|
'((t :inherit isearch-fail))
|
||
|
|
"Face for marker on line when non-default function is active."
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defface tabkey2-highlight-message
|
||
|
|
'((t :inherit tabkey2-highlight-line))
|
||
|
|
"Face for messages in echo area."
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defface tabkey2-highlight-popup
|
||
|
|
'((default :box t :inherit tabkey2-highlight-message)
|
||
|
|
(((class color) (background light)) :foreground "black")
|
||
|
|
(((class color) (background dark)) :foreground "yellow"))
|
||
|
|
"Face for popup messages."
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defcustom tabkey2-show-mark-on-active-line t
|
||
|
|
"Show mark on active line if non-nil.
|
||
|
|
This mark is shown during 'Tab completion state'."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defvar tabkey2-completion-lighter nil)
|
||
|
|
(defcustom tabkey2-completion-lighter-on nil
|
||
|
|
"Mode line lighter for function `tabkey2-completion-state-mode'."
|
||
|
|
:type 'boolean
|
||
|
|
:set (lambda (symbol value)
|
||
|
|
(set-default symbol value)
|
||
|
|
(setq tabkey2-completion-lighter (if value " Tab2" nil))
|
||
|
|
(setq minor-mode-alist
|
||
|
|
(assq-delete-all 'tabkey2-completion-state-mode
|
||
|
|
minor-mode-alist)))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defcustom tabkey2-show-message-on-enter 2.0
|
||
|
|
"If non-nil show message when entering 'Tab completion state'.
|
||
|
|
If value is a number then delay message that number of seconds."
|
||
|
|
:type '(choice (const :tag "Don't show" nil)
|
||
|
|
(const :tag "Show at once" t)
|
||
|
|
(float :tag "Show, but delayed (seconds)"))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
|
||
|
|
;; (setq tabkey2-message-style 'popup)
|
||
|
|
;; (setq tabkey2-message-style 'echo-area)
|
||
|
|
(defcustom tabkey2-message-style 'popup
|
||
|
|
"How to show messages."
|
||
|
|
:type '(choice (const :tag "Popup" popup)
|
||
|
|
(const :tag "Echo area" echo-area))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defcustom tabkey2-in-minibuffer nil
|
||
|
|
"If non-nil use command `tabkey2-mode' also in minibuffer."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defcustom tabkey2-in-appmenu t
|
||
|
|
"Show a completion menu in command `appmenu-mode' if t."
|
||
|
|
:type 'boolean
|
||
|
|
:set (lambda (sym val)
|
||
|
|
(set-default sym val)
|
||
|
|
(when (fboundp 'appmenu-add)
|
||
|
|
(if val
|
||
|
|
(appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu)
|
||
|
|
(appmenu-remove 'tabkey2))))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defun yas/expandable-at-point ()
|
||
|
|
"Return non-nil if a snippet can be expanded here."
|
||
|
|
(when (and (fboundp 'yas/template-condition-predicate)
|
||
|
|
(boundp 'yas/buffer-local-condition))
|
||
|
|
(yas/template-condition-predicate
|
||
|
|
yas/buffer-local-condition)))
|
||
|
|
|
||
|
|
(defvar tabkey2-company-backends
|
||
|
|
"List of frontends and their backends."
|
||
|
|
'((company-mode (NONE company-abbrev . "Abbrev")
|
||
|
|
(NONE company-css . "CSS")
|
||
|
|
(dabbrev-expan company-dabbrev . "dabbrev for plain text")
|
||
|
|
(NONE company-dabbrev-code . "dabbrev for code")
|
||
|
|
(NONE company-eclim . "eclim (an Eclipse interace)")
|
||
|
|
(lisp-symbol-complete company-elisp . "Emacs Lisp")
|
||
|
|
(complete-tag company-etags . "etags")
|
||
|
|
(NONE company-files . "Files")
|
||
|
|
(NONE company-gtags . "GNU Global")
|
||
|
|
(ispell-complete-word company-ispell . "ispell")
|
||
|
|
(flyspell-correct-word-before-point company-ispell . "ispell")
|
||
|
|
(NONE company-keywords . "Programming language keywords")
|
||
|
|
(nxml-complete company-nxml . "nxml")
|
||
|
|
(NONE company-oddmuse . "Oddmuse")
|
||
|
|
(NONE company-pysmell . "PySmell")
|
||
|
|
(NONE company-ropemacs . "ropemacs")
|
||
|
|
(senator-complete-symbol company-semantic . "CEDET Semantic")
|
||
|
|
(NONE company-tempo . "Tempo templates")
|
||
|
|
(NONE company-xcode . "Xcode"))))
|
||
|
|
|
||
|
|
(defun tabkey2-find-front-end (fun)
|
||
|
|
(let ((
|
||
|
|
))))
|
||
|
|
|
||
|
|
(defcustom tabkey2-completion-functions
|
||
|
|
'(
|
||
|
|
;; Front ends (should take care of the rest, ie temporary things,
|
||
|
|
;; snippets etc...)
|
||
|
|
("Company Mode completion" company-complete company-mode)
|
||
|
|
;; Temporary things
|
||
|
|
("Spell check word" flyspell-correct-word-before-point)
|
||
|
|
;; Snippets
|
||
|
|
("Yasnippet" yas/expand (yas/expandable-at-point))
|
||
|
|
;; Main mode related, often used
|
||
|
|
("Semantic Smart Completion" senator-complete-symbol senator-minor-mode)
|
||
|
|
("Programmable completion" pcomplete)
|
||
|
|
("nXML completion" nxml-complete)
|
||
|
|
("Complete Emacs symbol" lisp-complete-symbol)
|
||
|
|
("Widget complete" widget-complete)
|
||
|
|
("Comint Dynamic Complete" comint-dynamic-complete)
|
||
|
|
("PHP completion" php-complete-function)
|
||
|
|
("Tags completion" complete-tag)
|
||
|
|
;; General word completion
|
||
|
|
("Predictive word" complete-word-at-point predictive-mode)
|
||
|
|
("Predictive abbreviations" pabbrev-expand-maybe)
|
||
|
|
("Dynamic word expansion" dabbrev-expand nil (setq dabbrev--last-abbrev-location nil))
|
||
|
|
("Ispell complete word" ispell-complete-word)
|
||
|
|
;; The catch all
|
||
|
|
("Anything" anything (commandp 'anything))
|
||
|
|
)
|
||
|
|
"List of completion functions.
|
||
|
|
The first 'active' entry in this list is normally used during the
|
||
|
|
'Tab completion state' by `tabkey2-complete'. An entry in the
|
||
|
|
list should have either of this forms
|
||
|
|
|
||
|
|
\(TITLE COMPLETION-FUNCTION ACTIVE-FORM RESET-FORM)
|
||
|
|
|
||
|
|
TITLE to show in menus etc.
|
||
|
|
|
||
|
|
COMPLETION-FUNCTION is the completion function symbol.
|
||
|
|
|
||
|
|
The entry is considered active if the symbol COMPLETION-FUNCTION
|
||
|
|
is bound to a command and
|
||
|
|
|
||
|
|
- This function has a key binding at point.
|
||
|
|
|
||
|
|
or
|
||
|
|
|
||
|
|
- The elisp expression ACTIVE-FORM evaluates to non-nil. If it
|
||
|
|
is a single symbol then its variable value is used, otherwise
|
||
|
|
the elisp form is evaled.
|
||
|
|
|
||
|
|
RESET-FORM is used to reset the completion function before
|
||
|
|
calling it.
|
||
|
|
|
||
|
|
When choosing with `tabkey2-cycle-completion-functions'
|
||
|
|
only the currently active entry in this list are shown."
|
||
|
|
:type '(repeat (list string (choice (command :tag "Currently known command")
|
||
|
|
(symbol :tag "Command not known yet"))
|
||
|
|
(choice (const :tag "Active only if it has a key binding at point" nil)
|
||
|
|
(sexp :tag "Elisp, if evals to non-nil then active"))
|
||
|
|
(sexp :tag "Elisp, reset completion function")))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
;; Use emulation mode map for first Tab key
|
||
|
|
(defconst tabkey2-mode-emul-map (make-sparse-keymap)
|
||
|
|
"This keymap just binds tab and alternate key all the time.
|
||
|
|
By default this binds Tab to `tabkey2-first'. The actual keys
|
||
|
|
bound are in `tabkey2-first-key' and `tabkey2-alternate-key'.")
|
||
|
|
|
||
|
|
(defvar tabkey2--emul-keymap-alist nil)
|
||
|
|
|
||
|
|
;; (setq tabkey2-keymap-overlay nil)
|
||
|
|
(defconst tabkey2-completion-state-emul-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map [(control ?c) tab] 'tabkey2-make-current-default)
|
||
|
|
|
||
|
|
;;(define-key map tabkey2-alternate-key 'tabkey2-cycle-completion-functions)
|
||
|
|
(define-key map [backtab] 'tabkey2-cycle-completion-functions)
|
||
|
|
|
||
|
|
(define-key map [(control f1)] 'tabkey2-completion-function-help)
|
||
|
|
(define-key map [(meta f1)] 'tabkey2-show-completion-functions)
|
||
|
|
(define-key map [f1] 'tabkey2-completion-state-help)
|
||
|
|
|
||
|
|
(define-key map [(control ?g)] 'tabkey2-completion-state-off)
|
||
|
|
(define-key map [tab] 'tabkey2-complete)
|
||
|
|
map)
|
||
|
|
"This keymap is for `tabkey2-keymap-overlay'.")
|
||
|
|
|
||
|
|
(defun tabkey2-bind-keys (first-key alternate-key)
|
||
|
|
(let ((mode-map tabkey2-mode-emul-map)
|
||
|
|
(comp-map tabkey2-completion-state-emul-map))
|
||
|
|
;; First key
|
||
|
|
(when (and (boundp 'tabkey2-first-key)
|
||
|
|
tabkey2-first-key)
|
||
|
|
(define-key mode-map tabkey2-first-key nil))
|
||
|
|
(when first-key
|
||
|
|
(define-key mode-map first-key 'tabkey2-first))
|
||
|
|
;; Alternate key
|
||
|
|
(when (and (boundp 'tabkey2-alternate-key)
|
||
|
|
tabkey2-alternate-key)
|
||
|
|
(define-key mode-map tabkey2-alternate-key nil)
|
||
|
|
(define-key comp-map tabkey2-alternate-key nil))
|
||
|
|
(when alternate-key
|
||
|
|
(define-key mode-map alternate-key 'tabkey2-cycle-completion-functions)
|
||
|
|
(define-key comp-map alternate-key 'tabkey2-cycle-completion-functions))
|
||
|
|
(when (and (boundp 'tabkey2-completion-state-mode)
|
||
|
|
tabkey2-completion-state-mode)
|
||
|
|
(tabkey2-completion-state-mode -1)
|
||
|
|
(tabkey2-completion-state-mode 1))))
|
||
|
|
|
||
|
|
(defcustom tabkey2-first-key [tab]
|
||
|
|
"First key, first time indents, more invocations completes.
|
||
|
|
This key is always bound to `tabkey2-first'."
|
||
|
|
:set (lambda (sym val)
|
||
|
|
(set-default sym val)
|
||
|
|
(tabkey2-bind-keys
|
||
|
|
val
|
||
|
|
(when (boundp 'tabkey2-alternate-key)
|
||
|
|
tabkey2-alternate-key)))
|
||
|
|
:type 'key-sequence
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defcustom tabkey2-alternate-key [f8]
|
||
|
|
"Alternate key, bound to cycle and show completion functions.
|
||
|
|
This key is always bound to `tabkey2-cycle-completion-functions'."
|
||
|
|
:set (lambda (sym val)
|
||
|
|
(set-default sym val)
|
||
|
|
(tabkey2-bind-keys (when (boundp 'tabkey2-first-key) tabkey2-first-key) val))
|
||
|
|
:type 'key-sequence
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(tabkey2-bind-keys tabkey2-first-key tabkey2-alternate-key)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-minor-mode tabkey2-mode
|
||
|
|
"More fun with Tab key number two (completion etc).
|
||
|
|
This global minor mode by default binds Tab in a way that let you
|
||
|
|
do completion with Tab in all buffers \(where it is possible).
|
||
|
|
|
||
|
|
The Tab key is easy to type on your keyboard. Then why not use
|
||
|
|
it for completion, something that is very useful? Shells usually
|
||
|
|
use Tab for completion so many are used to it. This was the idea
|
||
|
|
of Smart Tabs and this is a generalization of that idea.
|
||
|
|
|
||
|
|
However in Emacs the Tab key is usually used for indentation.
|
||
|
|
The idea here is that if Tab has been pressed once for
|
||
|
|
indentation, then as long as point stays further Tab keys might
|
||
|
|
as well do completion.
|
||
|
|
|
||
|
|
So you kind of do Tab-Tab for first completion \(and then just
|
||
|
|
Tab for further completions as long as point is not moved).
|
||
|
|
|
||
|
|
And there is even kind of Tab-Tab-Tab completion: If completion
|
||
|
|
fails the next completion function will be the one you try with
|
||
|
|
next Tab. \(You get some notification of this, of course.)
|
||
|
|
|
||
|
|
See `tabkey2-first' for more information about usage.
|
||
|
|
|
||
|
|
Note: If you do not want the Tab-Tab behaviour above, but still
|
||
|
|
want an easy way to reach the available completion functions,
|
||
|
|
then you can instead of turning on tabkey2-mode enter this in
|
||
|
|
your .emacs:
|
||
|
|
|
||
|
|
\(global-set-key [f8] 'tabkey2-cycle-completion-functions)
|
||
|
|
|
||
|
|
After hitting f8 you will then be in the same state as after the
|
||
|
|
first in tabkey2-mode."
|
||
|
|
:keymap nil
|
||
|
|
:global t
|
||
|
|
:group 'tabkey2
|
||
|
|
(if tabkey2-mode
|
||
|
|
(progn
|
||
|
|
(add-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
|
||
|
|
(add-hook 'post-command-hook 'tabkey2-post-command)
|
||
|
|
;; Update emul here if keymap have changed
|
||
|
|
(setq tabkey2--emul-keymap-alist
|
||
|
|
(list (cons 'tabkey2-mode
|
||
|
|
tabkey2-mode-emul-map)))
|
||
|
|
(add-to-list 'emulation-mode-map-alists 'tabkey2--emul-keymap-alist))
|
||
|
|
(tabkey2-completion-state-mode -1)
|
||
|
|
(remove-hook 'post-command-hook 'tabkey2-post-command)
|
||
|
|
(remove-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
|
||
|
|
(setq emulation-mode-map-alists (delq 'tabkey2--emul-keymap-alist
|
||
|
|
emulation-mode-map-alists))))
|
||
|
|
|
||
|
|
(defcustom tabkey2-modes-that-use-more-tabs
|
||
|
|
'(python-mode
|
||
|
|
haskell-mode
|
||
|
|
makefile-mode
|
||
|
|
org-mode
|
||
|
|
Custom-mode
|
||
|
|
custom-mode ;; For Emacs 22
|
||
|
|
;; other
|
||
|
|
cmd-mode
|
||
|
|
)
|
||
|
|
"In those modes use must use S-Tab to start completion state.
|
||
|
|
In those modes pressing Tab several types may make sense so you
|
||
|
|
can not go into 'Tab completion state' just because one Tab has
|
||
|
|
been pressed. Instead you use S-Tab to go into that state.
|
||
|
|
After that Tab does completion.
|
||
|
|
|
||
|
|
You can do use S-Tab in other modes too if you want too."
|
||
|
|
:type '(repeat (choice (command :tag "Currently known command")
|
||
|
|
(symbol :tag "Command not known yet")))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defcustom tabkey2-modes-that-just-complete
|
||
|
|
'(shell-mode
|
||
|
|
fundamental-mode
|
||
|
|
text-mode)
|
||
|
|
"Tab is only used for completion in these modes.
|
||
|
|
Therefore `tabkey2-first' just calls the function on Tab."
|
||
|
|
:type '(repeat (choice (command :tag "Currently known command")
|
||
|
|
(symbol :tag "Command not known yet")))
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
;;(setq tabkey2-use-popup-menus nil)
|
||
|
|
;; (defcustom tabkey2-use-popup-menus (when (featurep 'popcmp) t)
|
||
|
|
;; "Use pop menus if available."
|
||
|
|
;; :type 'boolean
|
||
|
|
;; :group 'tabkey2)
|
||
|
|
|
||
|
|
;; (defvar tabkey2-preferred nil
|
||
|
|
;; "Preferred function for second tab key press.")
|
||
|
|
;; (make-variable-buffer-local 'tabkey2-preferred)
|
||
|
|
;; (put 'tabkey2-preferred 'permanent-local t)
|
||
|
|
|
||
|
|
(defvar tabkey2-fallback nil
|
||
|
|
"Fallback function for second tab key press.")
|
||
|
|
(make-variable-buffer-local 'tabkey2-fallback)
|
||
|
|
(put 'tabkey2-fallback 'permanent-local t)
|
||
|
|
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;;; State
|
||
|
|
|
||
|
|
(defvar tabkey2-overlay nil
|
||
|
|
"Show when tab key 2 action is to be done.")
|
||
|
|
(defvar tabkey2-keymap-overlay nil
|
||
|
|
"Hold the keymap for tab key 2.")
|
||
|
|
|
||
|
|
(defvar tabkey2-current-tab-info nil
|
||
|
|
"Saved information message for Tab completion state.")
|
||
|
|
(defvar tabkey2-current-tab-function nil
|
||
|
|
"Tab completion state current completion function.")
|
||
|
|
(make-variable-buffer-local 'tabkey2-current-tab-function)
|
||
|
|
|
||
|
|
(defun tabkey2-completion-state-p ()
|
||
|
|
"Return t if Tab completion state should continue.
|
||
|
|
Otherwise return nil."
|
||
|
|
(when (and (eq (current-buffer) (overlay-buffer tabkey2-keymap-overlay))
|
||
|
|
(eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window)))
|
||
|
|
(let* ((start (overlay-start tabkey2-keymap-overlay))
|
||
|
|
(end (overlay-end tabkey2-keymap-overlay))
|
||
|
|
(chars (append (buffer-substring-no-properties start end) nil)))
|
||
|
|
(and (not (memq ?\n chars))
|
||
|
|
(not (eq ?\ (car (last chars))))
|
||
|
|
(not (eq ?\ last-input-event))
|
||
|
|
(<= start (point))
|
||
|
|
(<= (point) end)
|
||
|
|
tabkey2-current-tab-function
|
||
|
|
(or (memq this-original-command '(tabkey2-first tabkey2-complete))
|
||
|
|
(let* ((last-name (symbol-name this-original-command))
|
||
|
|
(name-prefix "tabkey2-")
|
||
|
|
(prefix-len (length name-prefix)))
|
||
|
|
(and (> (length last-name) prefix-len)
|
||
|
|
(string= name-prefix (substring last-name 0 prefix-len)))))
|
||
|
|
))))
|
||
|
|
|
||
|
|
(defun tabkey2-read-only-p ()
|
||
|
|
"Return non-nil if buffer seems to be read-only at point."
|
||
|
|
(or buffer-read-only
|
||
|
|
(get-char-property (min (+ 0 (point)) (point-max)) 'read-only)
|
||
|
|
(let ((remap (command-remapping 'self-insert-command (point))))
|
||
|
|
(memq remap '(Custom-no-edit)))))
|
||
|
|
|
||
|
|
;;;; Minor mode active after first tab
|
||
|
|
|
||
|
|
(defun tabkey2-get-highlight-face ()
|
||
|
|
(if (eq tabkey2-current-tab-function
|
||
|
|
(tabkey2-first-active-from-completion-functions))
|
||
|
|
'tabkey2-highlight-line
|
||
|
|
'tabkey2-highlight-line2))
|
||
|
|
|
||
|
|
(defun tabkey2-move-overlays ()
|
||
|
|
"Move overlays that mark the state and carries the state keymap."
|
||
|
|
(let* ((beg (let ((inhibit-field-text-motion t))
|
||
|
|
(line-beginning-position)))
|
||
|
|
(ind (current-indentation))
|
||
|
|
(end (+ beg 1)) ;(if (> ind 0) ind 1)))
|
||
|
|
(inhibit-read-only t))
|
||
|
|
(unless tabkey2-overlay
|
||
|
|
(setq tabkey2-overlay (make-overlay beg end)))
|
||
|
|
;; Fix-me: gets some strange errors, try avoid moving:
|
||
|
|
(unless (and (eq (current-buffer) (overlay-buffer tabkey2-overlay))
|
||
|
|
(= beg (overlay-start tabkey2-overlay))
|
||
|
|
(= end (overlay-end tabkey2-overlay)))
|
||
|
|
(move-overlay tabkey2-overlay beg end (current-buffer)))
|
||
|
|
;; Give it a high priority, it is very temporary
|
||
|
|
(overlay-put tabkey2-overlay 'priority 1000)
|
||
|
|
(if tabkey2-show-mark-on-active-line
|
||
|
|
(progn
|
||
|
|
(overlay-put tabkey2-overlay 'face
|
||
|
|
;;'tabkey2-highlight-line
|
||
|
|
(tabkey2-get-highlight-face)
|
||
|
|
)
|
||
|
|
(overlay-put tabkey2-overlay 'help-echo
|
||
|
|
"This highlight shows that Tab completion state is on"))
|
||
|
|
(overlay-put tabkey2-overlay 'face nil)
|
||
|
|
(overlay-put tabkey2-overlay 'help-echo nil)))
|
||
|
|
;; The keymap overlay
|
||
|
|
(let ((beg (line-beginning-position))
|
||
|
|
(end (line-end-position)))
|
||
|
|
;;(when (= end (point-max)) (setq end (1+ end)))
|
||
|
|
(setq beg (point))
|
||
|
|
(setq end (point))
|
||
|
|
|
||
|
|
(unless tabkey2-keymap-overlay
|
||
|
|
;; Make the rear of the overlay advance so that the keymap works
|
||
|
|
;; at the end of a line and the end of the buffer.
|
||
|
|
(setq tabkey2-keymap-overlay (make-overlay 0 0 nil nil t)))
|
||
|
|
(overlay-put tabkey2-keymap-overlay 'priority 1000)
|
||
|
|
;;(overlay-put tabkey2-keymap-overlay 'face 'secondary-selection)
|
||
|
|
(overlay-put tabkey2-keymap-overlay 'keymap
|
||
|
|
tabkey2-completion-state-emul-map)
|
||
|
|
(overlay-put tabkey2-keymap-overlay 'window (selected-window))
|
||
|
|
(move-overlay tabkey2-keymap-overlay beg end (current-buffer))))
|
||
|
|
|
||
|
|
(defun tabkey2-is-active (fun chk)
|
||
|
|
"Return t FUN is active.
|
||
|
|
Return t if CHK is a symbol with non-nil value or a form that
|
||
|
|
evals to non-nil.
|
||
|
|
|
||
|
|
Otherwise return t if FUN has a key binding at point."
|
||
|
|
(when (and (fboundp fun)
|
||
|
|
(commandp fun))
|
||
|
|
(or (if (symbolp chk)
|
||
|
|
(when (boundp chk) (symbol-value chk))
|
||
|
|
(eval chk))
|
||
|
|
(let* ((emulation-mode-map-alists
|
||
|
|
;; Remove keymaps from tabkey2 in this copy:
|
||
|
|
(delq 'tabkey2--emul-keymap-alist
|
||
|
|
(copy-sequence emulation-mode-map-alists)))
|
||
|
|
(keys (tabkey2-symbol-keys fun))
|
||
|
|
kb-bound)
|
||
|
|
(dolist (key keys)
|
||
|
|
(unless (memq (car (append key nil))
|
||
|
|
'(menu-bar))
|
||
|
|
(setq kb-bound t)))
|
||
|
|
kb-bound))))
|
||
|
|
|
||
|
|
(defun tabkey2-is-active-p (fun)
|
||
|
|
"Return FUN is active.
|
||
|
|
Look it up in `tabkey2-completion-functions' to find out what to
|
||
|
|
check and return the value from `tabkey2-is-active'."
|
||
|
|
(let ((chk (catch 'chk
|
||
|
|
(dolist (rec tabkey2-completion-functions)
|
||
|
|
(when (eq fun (nth 1 rec))
|
||
|
|
(throw 'chk (nth 2 rec)))))))
|
||
|
|
(tabkey2-is-active fun chk)))
|
||
|
|
|
||
|
|
(defvar tabkey2-chosen-completion-function nil)
|
||
|
|
(make-variable-buffer-local 'tabkey2-chosen-completion-function)
|
||
|
|
(put 'tabkey2-chosen-completion-function 'permanent-local t)
|
||
|
|
|
||
|
|
(defun tabkey2-first-active-from-completion-functions ()
|
||
|
|
"Return first active completion function.
|
||
|
|
Look in `tabkey2-completion-functions' for the first function
|
||
|
|
that has an active key binding."
|
||
|
|
(catch 'active-fun
|
||
|
|
(dolist (rec tabkey2-completion-functions)
|
||
|
|
(let ((fun (nth 1 rec))
|
||
|
|
(chk (nth 2 rec)))
|
||
|
|
(when (tabkey2-is-active fun chk)
|
||
|
|
(throw 'active-fun fun))))))
|
||
|
|
|
||
|
|
(defun tabkey2-get-default-completion-fun ()
|
||
|
|
"Return the default completion function.
|
||
|
|
See `tabkey2-first' for the list considered."
|
||
|
|
(or (when (and tabkey2-chosen-completion-function
|
||
|
|
(tabkey2-is-active-p
|
||
|
|
tabkey2-chosen-completion-function))
|
||
|
|
tabkey2-chosen-completion-function)
|
||
|
|
;;tabkey2-preferred
|
||
|
|
(tabkey2-first-active-from-completion-functions)
|
||
|
|
tabkey2-fallback))
|
||
|
|
|
||
|
|
(defvar tabkey2-overlay-message nil)
|
||
|
|
|
||
|
|
(defvar tabkey2-completion-state-mode nil)
|
||
|
|
;;(make-variable-buffer-local 'tabkey2-completion-state-mode)
|
||
|
|
(defun tabkey2-completion-state-mode (arg)
|
||
|
|
"Tab completion state minor mode.
|
||
|
|
This pseudo-minor mode holds the 'Tab completion state'. When this
|
||
|
|
minor mode is on completion key bindings are available.
|
||
|
|
|
||
|
|
With ARG a positive number turn on, otherwise turn off this minor
|
||
|
|
mode.
|
||
|
|
|
||
|
|
See `tabkey2-first' for more information."
|
||
|
|
;;(assq-delete-all 'tabkey2-completion-state-mode minor-mode-alist)
|
||
|
|
(unless (assoc 'tabkey2-completion-state-mode minor-mode-alist)
|
||
|
|
;;(setq minor-mode-alist (cons '(tabkey2-completion-state-mode " Tab2")
|
||
|
|
(setq minor-mode-alist (cons (list 'tabkey2-completion-state-mode
|
||
|
|
tabkey2-completion-lighter)
|
||
|
|
minor-mode-alist)))
|
||
|
|
(let ((emul-map (cdr (car tabkey2--emul-keymap-alist)))
|
||
|
|
(old-wincfg tabkey2-completion-state-mode))
|
||
|
|
(setq tabkey2-completion-state-mode (when (and (numberp arg)
|
||
|
|
(> arg 0))
|
||
|
|
;;t
|
||
|
|
(current-window-configuration)
|
||
|
|
))
|
||
|
|
(if tabkey2-completion-state-mode
|
||
|
|
(progn
|
||
|
|
;; Set default completion function
|
||
|
|
(tabkey2-make-message-and-set-fun
|
||
|
|
(tabkey2-get-default-completion-fun))
|
||
|
|
;; Message
|
||
|
|
;;(setq tabkey2-message-is-shown nil)
|
||
|
|
(when tabkey2-show-message-on-enter
|
||
|
|
(tabkey2-show-current-message
|
||
|
|
(when (numberp tabkey2-show-message-on-enter)
|
||
|
|
tabkey2-show-message-on-enter)))
|
||
|
|
;; Move overlays
|
||
|
|
(tabkey2-move-overlays)
|
||
|
|
;; Work around eob keymap problem ...
|
||
|
|
;;(set-keymap-parent emul-map (overlay-get tabkey2-keymap-overlay
|
||
|
|
;; 'keymap))
|
||
|
|
;; Set up for pre/post-command-hook
|
||
|
|
(add-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
|
||
|
|
(add-hook 'post-command-hook 'tabkey2-completion-state-post-command))
|
||
|
|
;;(set-keymap-parent emul-map nil)
|
||
|
|
(setq tabkey2-current-tab-function nil)
|
||
|
|
(when (and old-wincfg
|
||
|
|
tabkey2-keymap-overlay
|
||
|
|
(eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
|
||
|
|
(not (active-minibuffer-window)))
|
||
|
|
(set-window-configuration old-wincfg))
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
(when tabkey2-keymap-overlay
|
||
|
|
(delete-overlay tabkey2-keymap-overlay))
|
||
|
|
(when tabkey2-overlay
|
||
|
|
(delete-overlay tabkey2-overlay)))
|
||
|
|
(remove-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
|
||
|
|
(remove-hook 'post-command-hook 'tabkey2-completion-state-post-command)
|
||
|
|
(tabkey2-overlay-message nil)
|
||
|
|
;;(message "")
|
||
|
|
)))
|
||
|
|
|
||
|
|
(defun tabkey2-completion-state-off ()
|
||
|
|
"Quit Tab completion state."
|
||
|
|
(interactive)
|
||
|
|
(tabkey2-completion-state-mode -1)
|
||
|
|
(let ((C-g-binding (or (key-binding [(control ?g)])
|
||
|
|
(key-binding "\C-g")))
|
||
|
|
did-more)
|
||
|
|
(when (and (boundp 'company-mode)
|
||
|
|
company-mode)
|
||
|
|
;;(message "tabkey2:company-abort")
|
||
|
|
(company-abort)
|
||
|
|
(setq did-more t))
|
||
|
|
(when (and C-g-binding
|
||
|
|
(not (eq C-g-binding this-command)))
|
||
|
|
;;(message "tabkey2:c-g=%s" C-g-binding)
|
||
|
|
(call-interactively C-g-binding)
|
||
|
|
(setq did-more t))
|
||
|
|
(message "Quit")))
|
||
|
|
|
||
|
|
(defvar tabkey2-message-is-shown nil)
|
||
|
|
(defun tabkey2-message-is-shown ()
|
||
|
|
(case tabkey2-message-style
|
||
|
|
('popup
|
||
|
|
(when tabkey2-overlay-message
|
||
|
|
(overlay-buffer tabkey2-overlay-message)))
|
||
|
|
('echo-area
|
||
|
|
(get (current-message) 'tabkey2))))
|
||
|
|
|
||
|
|
(defun tabkey2-completion-state-pre-command ()
|
||
|
|
"Run this in `pre-command-hook'.
|
||
|
|
Check if message is shown.
|
||
|
|
Remove overlay message.
|
||
|
|
Cancel delayed message."
|
||
|
|
;;(message "=====> tabkey2-completion-state-pre-command")
|
||
|
|
(condition-case err
|
||
|
|
(progn
|
||
|
|
(setq tabkey2-message-is-shown (tabkey2-message-is-shown))
|
||
|
|
;;(message "tabkey2-overlay-message=%s, is-shown=%s" tabkey2-overlay-message tabkey2-message-is-shown)
|
||
|
|
(tabkey2-overlay-message nil)
|
||
|
|
(tabkey2-cancel-delayed-message)
|
||
|
|
;;(message "here buffer=%s, this-command=%s" (current-buffer) this-command)
|
||
|
|
)
|
||
|
|
(error (message "tabkey2 pre: %s" (error-message-string err)))))
|
||
|
|
|
||
|
|
(defun tabkey2-completion-state-post-command ()
|
||
|
|
"Turn off Tab completion state if not feasable any more.
|
||
|
|
This is run in `post-command-hook' after each command."
|
||
|
|
(condition-case err
|
||
|
|
;;(save-match-data
|
||
|
|
;; Delayed messages
|
||
|
|
(if (not (tabkey2-completion-state-p))
|
||
|
|
(tabkey2-completion-state-mode -1)
|
||
|
|
;;(message "tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
|
||
|
|
(tabkey2-move-overlays))
|
||
|
|
;;)
|
||
|
|
(error (message "tabkey2 post: %s" (error-message-string err)))))
|
||
|
|
|
||
|
|
(defun tabkey2-minibuffer-setup ()
|
||
|
|
"Activate/deactivate function `tabkey2-mode' in minibuffer."
|
||
|
|
(set (make-local-variable 'tabkey2-mode)
|
||
|
|
(and tabkey2-mode
|
||
|
|
tabkey2-in-minibuffer))
|
||
|
|
(unless tabkey2-mode
|
||
|
|
(set (make-local-variable 'emulation-mode-map-alists)
|
||
|
|
(delq 'tabkey2--emul-keymap-alist
|
||
|
|
(copy-sequence emulation-mode-map-alists)))))
|
||
|
|
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;;; Message functions
|
||
|
|
|
||
|
|
;; Fix-me: Included in Emacs 23.
|
||
|
|
(unless (fboundp 'invisible-p)
|
||
|
|
(defun invisible-p (pos)
|
||
|
|
"Return non-nil if the character after POS is currently invisible."
|
||
|
|
(let ((prop
|
||
|
|
(get-char-property pos 'invisible)))
|
||
|
|
(if (eq buffer-invisibility-spec t)
|
||
|
|
prop
|
||
|
|
(if (listp prop)
|
||
|
|
(catch 'invis
|
||
|
|
(dolist (p prop)
|
||
|
|
(when (or (memq p buffer-invisibility-spec)
|
||
|
|
(assq p buffer-invisibility-spec))
|
||
|
|
(throw 'invis t))))
|
||
|
|
(or (memq prop buffer-invisibility-spec)
|
||
|
|
(assq prop buffer-invisibility-spec)))))))
|
||
|
|
|
||
|
|
;; (defun test-scroll ()
|
||
|
|
;; (interactive)
|
||
|
|
;; (setq debug-on-error t)
|
||
|
|
;; (let* ((buffer-name "test-scroll")
|
||
|
|
;; (buffer (get-buffer buffer-name)))
|
||
|
|
;; (when buffer (kill-buffer buffer))
|
||
|
|
;; (setq buffer (get-buffer-create buffer-name))
|
||
|
|
;; (switch-to-buffer buffer)
|
||
|
|
;; (message "here 1") (sit-for 1)
|
||
|
|
;; (condition-case err
|
||
|
|
;; (scroll-up 1)
|
||
|
|
;; (error (message "scroll-up error: %s" err)
|
||
|
|
;; (sit-for 1)))
|
||
|
|
;; (message "here 2") (sit-for 1)
|
||
|
|
;; (scroll-up 1)
|
||
|
|
;; (message "here 3") (sit-for 1)
|
||
|
|
;; ))
|
||
|
|
|
||
|
|
(defun tabkey2-overlay-message (txt)
|
||
|
|
"Display TXT below or above current line using an overlay."
|
||
|
|
;;(setq tabkey2-message-is-shown txt)
|
||
|
|
(if (not txt)
|
||
|
|
(when tabkey2-overlay-message
|
||
|
|
(delete-overlay tabkey2-overlay-message)
|
||
|
|
(setq tabkey2-overlay-message nil))
|
||
|
|
(let ((ovl tabkey2-overlay-message)
|
||
|
|
(column (current-column))
|
||
|
|
(txt-len (length txt))
|
||
|
|
(here (point))
|
||
|
|
beg end
|
||
|
|
(before "")
|
||
|
|
(after "")
|
||
|
|
ovl-str too-much
|
||
|
|
(is-eob (eobp))
|
||
|
|
(direction 1))
|
||
|
|
(unless ovl (setq ovl (make-overlay 0 0)))
|
||
|
|
(when tabkey2-overlay-message
|
||
|
|
(delete-overlay tabkey2-overlay-message))
|
||
|
|
(setq tabkey2-overlay-message ovl)
|
||
|
|
|
||
|
|
(when is-eob
|
||
|
|
(setq direction -1))
|
||
|
|
(when (and (/= (point-min) (window-start))
|
||
|
|
(not (pos-visible-in-window-p (min (point-max) (1+ (line-end-position))))))
|
||
|
|
;; Go back inside window to avoid aggressive scrolling:
|
||
|
|
(forward-line -1)
|
||
|
|
(scroll-up 1)
|
||
|
|
(forward-line 1))
|
||
|
|
(forward-line direction)
|
||
|
|
;; Fix-me: Emacs bug workaround
|
||
|
|
(if (when (< 1 (point))
|
||
|
|
(invisible-p (1- (line-end-position))))
|
||
|
|
(progn
|
||
|
|
(goto-char here)
|
||
|
|
(tabkey2-echo-area-message txt))
|
||
|
|
;; Fix-me: Does this really do anything now:
|
||
|
|
(when (invisible-p (point))
|
||
|
|
(while (invisible-p (point))
|
||
|
|
(forward-line direction)))
|
||
|
|
(setq beg (line-beginning-position))
|
||
|
|
(setq end (line-end-position))
|
||
|
|
|
||
|
|
(if (or (invisible-p beg) (invisible-p end))
|
||
|
|
;; Give up, do not fight invisibility:
|
||
|
|
(progn
|
||
|
|
(tabkey2-overlay-message nil)
|
||
|
|
(tabkey2-echo-area-message txt))
|
||
|
|
|
||
|
|
;; string before
|
||
|
|
(move-to-column column)
|
||
|
|
(setq before (buffer-substring beg (point)))
|
||
|
|
(when (< (current-column) column)
|
||
|
|
(setq before
|
||
|
|
(concat before
|
||
|
|
(make-string (- column (current-column)) ? ))))
|
||
|
|
(setq too-much (- (+ 1 txt-len (length before))
|
||
|
|
(window-width)))
|
||
|
|
(when (> too-much 0)
|
||
|
|
(setq before (substring before 0 (- too-much))))
|
||
|
|
|
||
|
|
(unless (> too-much 0)
|
||
|
|
(move-to-column (+ txt-len (length before)))
|
||
|
|
(setq after (buffer-substring (point) end)))
|
||
|
|
|
||
|
|
(setq ovl-str (concat before
|
||
|
|
(propertize txt 'face 'tabkey2-highlight-popup)
|
||
|
|
after
|
||
|
|
))
|
||
|
|
|
||
|
|
(overlay-put ovl 'after-string ovl-str)
|
||
|
|
(overlay-put ovl 'display "")
|
||
|
|
(overlay-put ovl 'window (selected-window))
|
||
|
|
(move-overlay ovl beg end (current-buffer)))
|
||
|
|
|
||
|
|
(goto-char here)
|
||
|
|
))))
|
||
|
|
|
||
|
|
;; Fix-me: This was not usable IMO. Too much flickering.
|
||
|
|
;; (defun tabkey2-tooltip (txt)
|
||
|
|
;; (let* ((params tooltip-frame-parameters)
|
||
|
|
;; (coord (car (point-to-coord (point))))
|
||
|
|
;; (left (car coord))
|
||
|
|
;; (top (cadr coord))
|
||
|
|
;; tooltip-frame-parameters
|
||
|
|
;; )
|
||
|
|
;; ;; Fix-me: how do you get char height??
|
||
|
|
;; (setq top (+ top 50))
|
||
|
|
;; (setq params (tooltip-set-param params 'left left))
|
||
|
|
;; (setq params (tooltip-set-param params 'top top))
|
||
|
|
;; (setq params (tooltip-set-param params 'top top))
|
||
|
|
;; (setq tooltip-frame-parameters params)
|
||
|
|
;; (tooltip-hide)
|
||
|
|
;; (tooltip-show txt nil)))
|
||
|
|
|
||
|
|
(defun tabkey2-echo-area-message (txt)
|
||
|
|
"Show TXT in the echo area with a special face.
|
||
|
|
Shown with the face `tabkey2-highlight-message'."
|
||
|
|
(message "%s" (propertize txt
|
||
|
|
'face 'tabkey2-highlight-message
|
||
|
|
'tabkey2 t)))
|
||
|
|
|
||
|
|
(defun tabkey2-deliver-message (txt)
|
||
|
|
"Show message TXT to user."
|
||
|
|
(case tabkey2-message-style
|
||
|
|
(popup (tabkey2-overlay-message txt))
|
||
|
|
(t (tabkey2-echo-area-message txt))))
|
||
|
|
|
||
|
|
(defun tabkey2-timer-deliver-message (txt where)
|
||
|
|
"Show message TXT to user.
|
||
|
|
Protect from errors cause this is run during a timer."
|
||
|
|
(save-match-data ;; runs in timer
|
||
|
|
(when (and tabkey2-completion-state-mode
|
||
|
|
(equal (point-marker) where))
|
||
|
|
(condition-case err
|
||
|
|
(tabkey2-deliver-message txt)
|
||
|
|
(error (message "tabkey2-timer-deliver-message: %s"
|
||
|
|
(error-message-string err)))))))
|
||
|
|
|
||
|
|
(defvar tabkey2-delayed-timer nil)
|
||
|
|
|
||
|
|
(defun tabkey2-cancel-delayed-message ()
|
||
|
|
"Cancel delayed message."
|
||
|
|
(when tabkey2-delayed-timer
|
||
|
|
(cancel-timer tabkey2-delayed-timer)
|
||
|
|
(setq tabkey2-delayed-timer)))
|
||
|
|
|
||
|
|
(defun tabkey2-maybe-delayed-message (txt delay)
|
||
|
|
"Show message TXT, delay it if DELAY is non-nil."
|
||
|
|
(if delay
|
||
|
|
(setq tabkey2-delayed-timer
|
||
|
|
(run-with-idle-timer
|
||
|
|
delay nil
|
||
|
|
'tabkey2-timer-deliver-message txt (point-marker)))
|
||
|
|
(tabkey2-deliver-message txt)))
|
||
|
|
|
||
|
|
(defun tabkey2-message (delay format-string &rest args)
|
||
|
|
"Show, if DELAY delayed, otherwise immediately message.
|
||
|
|
FORMAT-STRING and ARGS are like for `message'."
|
||
|
|
(let ((txt (apply 'format format-string args)))
|
||
|
|
(tabkey2-maybe-delayed-message txt delay)))
|
||
|
|
|
||
|
|
(defun tabkey2-show-current-message (&optional delay)
|
||
|
|
"Show current completion message, delayed if DELAY is non-nil."
|
||
|
|
(tabkey2-cancel-delayed-message)
|
||
|
|
(tabkey2-message delay "%s" tabkey2-current-tab-info))
|
||
|
|
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;;; Completion function selection etc
|
||
|
|
|
||
|
|
(defun tabkey2-symbol-keys (comp-fun)
|
||
|
|
"Get a list of all key bindings for COMP-FUN."
|
||
|
|
(let* ((remapped (command-remapping comp-fun)))
|
||
|
|
(where-is-internal comp-fun
|
||
|
|
nil ;;overriding-local-map
|
||
|
|
nil nil remapped)))
|
||
|
|
|
||
|
|
(defun tabkey2-get-active-completion-functions ()
|
||
|
|
"Get a list of active completion functions.
|
||
|
|
Consider only those in `tabkey2-completion-functions'."
|
||
|
|
(delq nil
|
||
|
|
(mapcar (lambda (rec)
|
||
|
|
(let ((fun (nth 1 rec))
|
||
|
|
(chk (nth 2 rec)))
|
||
|
|
(when (tabkey2-is-active fun chk) rec)))
|
||
|
|
tabkey2-completion-functions)))
|
||
|
|
|
||
|
|
(defun tabkey2-make-current-default ()
|
||
|
|
"Make current Tab completion function default.
|
||
|
|
Set the current Tab completion function at point as default for
|
||
|
|
the current buffer."
|
||
|
|
(interactive)
|
||
|
|
(let ((set-it
|
||
|
|
(y-or-n-p
|
||
|
|
(format
|
||
|
|
"Make %s default for Tab completion in current buffer? "
|
||
|
|
tabkey2-current-tab-function))))
|
||
|
|
(when set-it
|
||
|
|
(setq tabkey2-chosen-completion-function
|
||
|
|
tabkey2-current-tab-function))
|
||
|
|
(unless set-it
|
||
|
|
(when (local-variable-p 'tabkey2-chosen-completion-function)
|
||
|
|
(when (y-or-n-p "Use default Tab completion selection in buffer? ")
|
||
|
|
(setq set-it t))
|
||
|
|
(kill-local-variable 'tabkey2-chosen-completion-function)))
|
||
|
|
(when (tabkey2-completion-state-p)
|
||
|
|
(tabkey2-message nil "%s%s" tabkey2-current-tab-info
|
||
|
|
(if set-it " - Done" "")))))
|
||
|
|
|
||
|
|
(defun tabkey2-activate-next-completion-function (wrap)
|
||
|
|
(let* ((active (mapcar (lambda (rec)
|
||
|
|
(nth 1 rec))
|
||
|
|
(tabkey2-get-active-completion-functions)))
|
||
|
|
(first (car active))
|
||
|
|
next)
|
||
|
|
;;(message "is-shown=%s current=%s active=%s overlay=%s" tabkey2-message-is-shown tabkey2-current-tab-function active tabkey2-overlay)
|
||
|
|
(when tabkey2-current-tab-function
|
||
|
|
(while (and active (not next))
|
||
|
|
(when (eq (car active) tabkey2-current-tab-function)
|
||
|
|
(setq next (cadr active)))
|
||
|
|
(setq active (cdr active))))
|
||
|
|
(unless next
|
||
|
|
(when wrap (setq next first)))
|
||
|
|
;;(if (eq first next)
|
||
|
|
(tabkey2-make-message-and-set-fun next)))
|
||
|
|
|
||
|
|
(defun tabkey2-cycle-completion-functions (prefix)
|
||
|
|
"Cycle through cnd display ompletion functions.
|
||
|
|
If 'Tab completion state' is not on then turn it on.
|
||
|
|
|
||
|
|
If PREFIX is given just show what this command will do."
|
||
|
|
(interactive "P")
|
||
|
|
(if (tabkey2-read-only-p)
|
||
|
|
(message "Buffer is read only at point")
|
||
|
|
(unless tabkey2-completion-state-mode (tabkey2-completion-state-mode 1))
|
||
|
|
(save-match-data
|
||
|
|
(if prefix
|
||
|
|
;; fix-me
|
||
|
|
(message "(TabKey2) %s: show/cycle completion function"
|
||
|
|
last-input-event)
|
||
|
|
(when tabkey2-message-is-shown
|
||
|
|
;; Message is shown currently so change
|
||
|
|
(tabkey2-activate-next-completion-function 'wrap))
|
||
|
|
(tabkey2-show-current-message)))))
|
||
|
|
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;;; Handling of Tab and alternate key
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun tabkey2-emma-without-tabkey2 ()
|
||
|
|
;; Remove keymaps from tabkey2 in this copy:
|
||
|
|
(delq 'tabkey2--emul-keymap-alist
|
||
|
|
(copy-sequence emulation-mode-map-alists)))
|
||
|
|
|
||
|
|
(defvar tabkey2-step-out-of-the-way nil)
|
||
|
|
;;(remove-hook 'pre-command-hook 'tabkey2-pre-command)
|
||
|
|
;;(remove-hook 'post-command-hook 'tabkey2-pre-command)
|
||
|
|
;;(remove-hook 'post-command-hook 'tabkey2-post-command-2)
|
||
|
|
(defun tabkey2-post-command ()
|
||
|
|
(setq tabkey2-step-out-of-the-way nil)
|
||
|
|
(condition-case err
|
||
|
|
(when tabkey2-mode
|
||
|
|
(when (and (boundp 'company-overriding-keymap-bound) company-overriding-keymap-bound)
|
||
|
|
(setq tabkey2-step-out-of-the-way
|
||
|
|
(let ((emulation-mode-map-alists (tabkey2-emma-without-tabkey2)))
|
||
|
|
(key-binding (this-command-keys))))
|
||
|
|
;;(message "tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
|
||
|
|
))
|
||
|
|
(error "tabkey2-pre-command: %s" err)))
|
||
|
|
;; (and (boundp 'company-preview-overlay)
|
||
|
|
;; (or company-preview-overlay
|
||
|
|
;; company-pseudo-tooltip-overlay)))
|
||
|
|
(defun tabkey2-first (prefix)
|
||
|
|
"Do something else after first Tab.
|
||
|
|
This function is bound to the Tab key \(or whatever key
|
||
|
|
`tabkey2-first-key' is) when minor mode command `tabkey2-mode' is
|
||
|
|
on. It works like this:
|
||
|
|
|
||
|
|
1. The first time Tab is pressed do whatever Tab would have done
|
||
|
|
if minor mode command `tabkey2-mode' was off.
|
||
|
|
|
||
|
|
Then before next command enter a new temporary 'Tab completion
|
||
|
|
state' for just the next command. Show this by a highlight on
|
||
|
|
the indentation and a marker \"Tab2\" in the mode line.
|
||
|
|
|
||
|
|
However if either
|
||
|
|
- the minibuffer is active and `tabkey2-in-minibuffer' is nil
|
||
|
|
- `major-mode' is in `tabkey2-modes-that-use-more-tabs' then
|
||
|
|
do not enter this temporary 'Tab completion state'.
|
||
|
|
|
||
|
|
For major modes where it make sense to press Tab several times
|
||
|
|
you can use `tabkey2-alternate-key' to enter 'Tab completion
|
||
|
|
state'.
|
||
|
|
|
||
|
|
|
||
|
|
2. As long as point is not move do completion when Tab is pressed
|
||
|
|
again. Show that this state is active with a highlighting at
|
||
|
|
the line beginning, a marker on the mode line (Tab2) and a
|
||
|
|
message in the echo area which tells what kind of completion
|
||
|
|
will be done.
|
||
|
|
|
||
|
|
When deciding what kind of completion to do look in the table
|
||
|
|
below and do whatever it found first that is not nil:
|
||
|
|
|
||
|
|
- `tabkey2-preferred'
|
||
|
|
- `tabkey2-completion-functions'
|
||
|
|
- `tabkey2-fallback'
|
||
|
|
|
||
|
|
3. Of course, there must be some way for you to easily determine
|
||
|
|
what kind of completion because there are many in Emacs. If
|
||
|
|
you do not turn it off this function will show that to you.
|
||
|
|
And if you turn it off you can still display it, see the key
|
||
|
|
bindings below.
|
||
|
|
|
||
|
|
If this function is used with a PREFIX argument then it just
|
||
|
|
shows what Tab will do.
|
||
|
|
|
||
|
|
If the default kind of completion is not what you want then
|
||
|
|
you can choose completion function from any of the candidates
|
||
|
|
in `tabkey2-completion-functions'. During the 'Tab completion
|
||
|
|
state' the following extra key bindings are available:
|
||
|
|
|
||
|
|
\\{tabkey2-completion-state-emul-map}
|
||
|
|
|
||
|
|
Of course, some languages does not have a fixed indent as is
|
||
|
|
assumed above. You can put major modes for those in
|
||
|
|
`tabkey2-modes-that-just-complete'.
|
||
|
|
|
||
|
|
Some major modes uses tab for something else already. Those are
|
||
|
|
in `tabkey2-modes-that-use-more-tabs'. There is an alternate
|
||
|
|
key, `tabkey2-alternate-key' if you want to do completion
|
||
|
|
there. Note that this key does not do completion. It however
|
||
|
|
enters 'Tab completion state' in which you have access to the
|
||
|
|
keys above for completion etc. \(This key also lets you cycle
|
||
|
|
through the completion functions too choose which one to use.)
|
||
|
|
|
||
|
|
-----
|
||
|
|
NOTE: This uses `emulation-mode-map-alists' and it supposes that
|
||
|
|
nothing else is bound to Tab there."
|
||
|
|
(interactive "P")
|
||
|
|
;;(message "first:tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
|
||
|
|
(if tabkey2-step-out-of-the-way
|
||
|
|
(progn
|
||
|
|
(message "step-out=%s" tabkey2-step-out-of-the-way)
|
||
|
|
(call-interactively tabkey2-step-out-of-the-way))
|
||
|
|
(if (and tabkey2-keymap-overlay
|
||
|
|
(eq (overlay-buffer tabkey2-keymap-overlay) (current-buffer))
|
||
|
|
(eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
|
||
|
|
(>= (point) (overlay-start tabkey2-keymap-overlay))
|
||
|
|
(<= (point) (overlay-end tabkey2-keymap-overlay)))
|
||
|
|
;; We should maybe not be here, but the keymap does not work at
|
||
|
|
;; the end of the buffer so we call the second tab function from
|
||
|
|
;; here:
|
||
|
|
(if (memq 'shift (event-modifiers last-input-event))
|
||
|
|
(call-interactively 'tabkey2-cycle-completion-functions)
|
||
|
|
(call-interactively 'tabkey2-complete prefix))
|
||
|
|
(let* ((emma-without-tabkey2 (tabkey2-emma-without-tabkey2))
|
||
|
|
(at-word-end (looking-at "\\_>"))
|
||
|
|
(just-complete (or (memq major-mode tabkey2-modes-that-just-complete)
|
||
|
|
at-word-end))
|
||
|
|
(what (if just-complete
|
||
|
|
'complete
|
||
|
|
(if (or (unless tabkey2-in-minibuffer
|
||
|
|
(active-minibuffer-window))
|
||
|
|
(when (fboundp 'use-region-p) (use-region-p))
|
||
|
|
(not at-word-end)
|
||
|
|
(memq major-mode tabkey2-modes-that-use-more-tabs))
|
||
|
|
'indent
|
||
|
|
'indent-complete
|
||
|
|
)))
|
||
|
|
(to-do-1 (unless (or
|
||
|
|
;; Skip action on tab if shift tab,
|
||
|
|
;; backtab or a mode in the "just
|
||
|
|
;; complete" list
|
||
|
|
(memq 'shift (event-modifiers last-input-event))
|
||
|
|
(equal [backtab] (this-command-keys-vector))
|
||
|
|
)
|
||
|
|
(let ((emulation-mode-map-alists emma-without-tabkey2))
|
||
|
|
;; Fix-me: Is this the way to pick up "tab keys"?
|
||
|
|
(or (key-binding [tab] t)
|
||
|
|
(key-binding [?\t] t))
|
||
|
|
)))
|
||
|
|
(to-do-2 (unless (or ;;(memq what '(complete))
|
||
|
|
(memq what '(indent))
|
||
|
|
(memq to-do-1 '(widget-forward button-forward)))
|
||
|
|
(tabkey2-get-default-completion-fun))))
|
||
|
|
;;(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)
|
||
|
|
(if prefix
|
||
|
|
(if (memq 'shift (event-modifiers last-input-event))
|
||
|
|
(message
|
||
|
|
"(TabKey2) First shift %s: turn on 'Tab completion state'"
|
||
|
|
last-input-event)
|
||
|
|
(message "(TabKey2) First %s: %s, next: maybe %s"
|
||
|
|
last-input-event to-do-1
|
||
|
|
(if to-do-2 to-do-2 "(same)")))
|
||
|
|
(when to-do-1
|
||
|
|
(let (xmumamo-multi-major-mode)
|
||
|
|
(tabkey2-call-interactively to-do-1)))
|
||
|
|
(unless (tabkey2-read-only-p)
|
||
|
|
(when to-do-2
|
||
|
|
(tabkey2-completion-state-mode 1))))))))
|
||
|
|
|
||
|
|
(defun tabkey2-call-interactively (function)
|
||
|
|
"Like `call-interactively, but handle `this-command'."
|
||
|
|
(setq this-command function)
|
||
|
|
(call-interactively function))
|
||
|
|
|
||
|
|
(defcustom tabkey2-choose-next-on-error t
|
||
|
|
"Choose next completion function on error."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'tabkey2)
|
||
|
|
|
||
|
|
(defun tabkey2-complete (prefix)
|
||
|
|
"Call current completion function.
|
||
|
|
If used with a PREFIX argument then just show what Tab will do."
|
||
|
|
(interactive "P")
|
||
|
|
(if (and (boundp 'mumamo-multi-major-mode)
|
||
|
|
mumamo-multi-major-mode
|
||
|
|
(not (mumamo-syntax-maybe-completable (point))))
|
||
|
|
(message "Please move out of chunk border before trying to complete.")
|
||
|
|
(if prefix
|
||
|
|
(message "(TabKey2) %s: %s"
|
||
|
|
last-input-event tabkey2-current-tab-function)
|
||
|
|
(let ((here (point))
|
||
|
|
(res (if tabkey2-choose-next-on-error
|
||
|
|
(condition-case err
|
||
|
|
(tabkey2-call-interactively tabkey2-current-tab-function)
|
||
|
|
(error (message "%s" (error-message-string err))
|
||
|
|
nil))
|
||
|
|
(tabkey2-call-interactively tabkey2-current-tab-function))))
|
||
|
|
(when (and (not res) (= here (point)))
|
||
|
|
(tabkey2-activate-next-completion-function nil)
|
||
|
|
;;(message "complete.tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
|
||
|
|
(if tabkey2-current-tab-function
|
||
|
|
(tabkey2-show-current-message)
|
||
|
|
(message "No more active completion functions in this buffer")))))))
|
||
|
|
|
||
|
|
;; Fix-me: I am not sure that it really is useful with a globalized
|
||
|
|
;; minor mode here because there are so many other ways to control
|
||
|
|
;; what happens in a specific buffer. Maybe it would just be
|
||
|
|
;; confusing?
|
||
|
|
;;
|
||
|
|
;; If found another problem with making it globalized: tabkey2-mode
|
||
|
|
;; uses emulation-mode-map-alist. I decided to remove this therefore.
|
||
|
|
;;
|
||
|
|
;; (defun tabkey2-turn-on ()
|
||
|
|
;; "Turn on `tabkey2-mode' in current buffer."
|
||
|
|
;; (tabkey2-mode 1))
|
||
|
|
|
||
|
|
;; (defvar tabkey2-turn-on-function 'tabkey2-turn-on
|
||
|
|
;; "Function used to mabye turn on `tabkey2-mode' in current-buffer.
|
||
|
|
;; This function is used by `tabkey2-global-mode' to turn on
|
||
|
|
;; `tabkey2-mode'.")
|
||
|
|
|
||
|
|
;; (defun tabkey2-turn-on-in-buffer ()
|
||
|
|
;; (funcall tabkey2-turn-on-function))
|
||
|
|
|
||
|
|
;; (define-globalized-minor-mode tabkey2-global-mode
|
||
|
|
;; tabkey2-mode tabkey2-turn-on-in-buffer)
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;;; Help functions
|
||
|
|
|
||
|
|
(defun tabkey2-show-completion-state-help ()
|
||
|
|
"Help for 'Tab completion state'.
|
||
|
|
To get out of this state you can move out of the current line.
|
||
|
|
|
||
|
|
During this state the keymap below is active. This state stops
|
||
|
|
as soon as you leave the current row.
|
||
|
|
|
||
|
|
\\{tabkey2-completion-state-emul-map}
|
||
|
|
See function `tabkey2-mode' for more information.
|
||
|
|
|
||
|
|
If you want to use Emacs normal help function then press F1
|
||
|
|
again.")
|
||
|
|
|
||
|
|
(defun tabkey2-completion-state-help ()
|
||
|
|
"Show help for 'Tab completion state'."
|
||
|
|
(interactive)
|
||
|
|
;;(message "tckv=%s" (this-command-keys-vector)) ;;(sit-for 1)
|
||
|
|
;; Fix-me: There seems to be an Emacs bug lurking here. Sometimes
|
||
|
|
;; invoked-by-f1 is not [f1].
|
||
|
|
(let ((invoked-by-f1 (equal (this-command-keys-vector) [f1]))
|
||
|
|
normal-help)
|
||
|
|
;;(message "invoked-by-f1=%s" invoked-by-f1) ;; fix-me
|
||
|
|
(if (not invoked-by-f1)
|
||
|
|
(describe-function 'tabkey2-show-completion-state-help)
|
||
|
|
(setq normal-help
|
||
|
|
(read-event
|
||
|
|
(propertize
|
||
|
|
(concat "Type a key for Emacs help."
|
||
|
|
" Or, wait for Tab completion state help: ")
|
||
|
|
'face 'highlight)
|
||
|
|
nil
|
||
|
|
4))
|
||
|
|
(case normal-help
|
||
|
|
((nil)
|
||
|
|
;;(message "Tab completion state help")
|
||
|
|
(describe-function 'tabkey2-show-completion-state-help))
|
||
|
|
(?c
|
||
|
|
(call-interactively 'describe-key-briefly))
|
||
|
|
(?k
|
||
|
|
(call-interactively 'describe-key))
|
||
|
|
(t
|
||
|
|
(tabkey2-completion-state-mode -1)
|
||
|
|
(setq unread-command-events
|
||
|
|
(reverse
|
||
|
|
(cons
|
||
|
|
normal-help
|
||
|
|
(append (this-command-keys) nil)))))))))
|
||
|
|
|
||
|
|
(defun tabkey2-completion-function-help ()
|
||
|
|
"Show help for current completion function."
|
||
|
|
(interactive)
|
||
|
|
(describe-function tabkey2-current-tab-function))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(defun tabkey2-get-key-binding (fun t2)
|
||
|
|
"Get key binding for FUN during 'Tab completion state'."
|
||
|
|
(let* ((remapped (command-remapping fun))
|
||
|
|
(key (where-is-internal fun
|
||
|
|
(when t2 tabkey2-completion-state-emul-map)
|
||
|
|
t
|
||
|
|
nil
|
||
|
|
remapped)))
|
||
|
|
key))
|
||
|
|
|
||
|
|
;; (defun tabkey2-reset-completion-function (comp-fun)
|
||
|
|
;; "Reset states for functions in `tabkey2-completion-functions'."
|
||
|
|
;; ;; Fix-me: remove hard-coding
|
||
|
|
;; (setq dabbrev--last-abbrev-location nil))
|
||
|
|
|
||
|
|
(defun tabkey2-make-message-and-set-fun (comp-fun)
|
||
|
|
"Set current completion function to COMP-FUN.
|
||
|
|
Build message but don't show it."
|
||
|
|
;;(tabkey2-reset-completion-functions)
|
||
|
|
(let* ((chs-fun 'tabkey2-cycle-completion-functions)
|
||
|
|
(key (tabkey2-get-key-binding chs-fun t))
|
||
|
|
;;(def-fun (tabkey2-get-default-completion-fun))
|
||
|
|
what
|
||
|
|
(comp-fun-key (tabkey2-get-key-binding comp-fun nil))
|
||
|
|
reset)
|
||
|
|
(setq tabkey2-current-tab-function comp-fun)
|
||
|
|
(dolist (rec tabkey2-completion-functions)
|
||
|
|
(let ((fun (nth 1 rec))
|
||
|
|
(txt (nth 0 rec))
|
||
|
|
(res (nth 3 rec)))
|
||
|
|
(when (eq fun comp-fun)
|
||
|
|
(eval res)
|
||
|
|
(setq what txt))))
|
||
|
|
(let ((info (concat (format "Tab: %s" what)
|
||
|
|
(if comp-fun-key
|
||
|
|
(format " (%s)" (key-description comp-fun-key))
|
||
|
|
"")
|
||
|
|
(if (cdr (tabkey2-get-active-completion-functions))
|
||
|
|
(format ", other %s, help F1"
|
||
|
|
(key-description key))
|
||
|
|
""))))
|
||
|
|
(setq tabkey2-current-tab-info info))))
|
||
|
|
|
||
|
|
(defun tabkey2-get-active-string (bnd fun buf)
|
||
|
|
"Get string to show for state.
|
||
|
|
BND: means active
|
||
|
|
FUN: function
|
||
|
|
BUF: buffer"
|
||
|
|
(if bnd
|
||
|
|
(if (with-current-buffer buf (tabkey2-read-only-p))
|
||
|
|
(propertize "active, but read-only" 'face '( :foreground "red"))
|
||
|
|
(propertize "active" 'face '( :foreground "green3")))
|
||
|
|
(if (and (fboundp fun)
|
||
|
|
(commandp fun))
|
||
|
|
(propertize "not active" 'face '( :foreground "red2"))
|
||
|
|
(propertize "not defined" 'face '( :foreground "gray")))))
|
||
|
|
|
||
|
|
(defun tabkey2-show-completion-functions ()
|
||
|
|
"Show what currently may be used for completion."
|
||
|
|
(interactive)
|
||
|
|
(let ((orig-buf (current-buffer))
|
||
|
|
(orig-mn mode-name)
|
||
|
|
(active-mark (concat " "
|
||
|
|
(propertize "<= default"
|
||
|
|
'face '( :background "yellow"))))
|
||
|
|
(act-found nil)
|
||
|
|
(chosen-fun tabkey2-chosen-completion-function)
|
||
|
|
what
|
||
|
|
chosen)
|
||
|
|
(when chosen-fun
|
||
|
|
(dolist (rec tabkey2-completion-functions)
|
||
|
|
(let ((fun (nth 1 rec))
|
||
|
|
(txt (nth 0 rec)))
|
||
|
|
(when (eq fun chosen-fun) (setq what txt))))
|
||
|
|
(setq chosen (list what chosen-fun)))
|
||
|
|
(with-output-to-temp-buffer (help-buffer)
|
||
|
|
(help-setup-xref (list #'tabkey2-show-completion-functions)
|
||
|
|
(interactive-p))
|
||
|
|
(with-current-buffer (help-buffer)
|
||
|
|
(insert (concat "The completion functions available for"
|
||
|
|
" 'Tab completion' in buffer\n'"
|
||
|
|
(buffer-name orig-buf)
|
||
|
|
"' at point with mode " orig-mn " are shown below.\n"
|
||
|
|
"The first active function is used by default.\n\n"))
|
||
|
|
(if (not chosen)
|
||
|
|
(insert " No completion function is set as default.")
|
||
|
|
(let* ((txt (nth 0 chosen))
|
||
|
|
(fun (nth 1 chosen))
|
||
|
|
(chk (nth 2 chosen))
|
||
|
|
(bnd (with-current-buffer orig-buf
|
||
|
|
(tabkey2-is-active fun chk)))
|
||
|
|
(act (tabkey2-get-active-string bnd fun orig-buf)))
|
||
|
|
(insert (format " Default is set to\n %s (%s): %s"
|
||
|
|
txt fun act))
|
||
|
|
(when bnd (insert active-mark) (setq act-found t))))
|
||
|
|
(insert "\n\n")
|
||
|
|
;;; (if (not tabkey2-preferred)
|
||
|
|
;;; (insert " None is preferred")
|
||
|
|
;;; (let* ((txt (nth 0 tabkey2-preferred))
|
||
|
|
;;; (fun (nth 1 tabkey2-preferred))
|
||
|
|
;;; (chk (nth 2 chosen))
|
||
|
|
;;; (bnd (with-current-buffer orig-buf
|
||
|
|
;;; (tabkey2-is-active fun chk)))
|
||
|
|
;;; (act (tabkey2-get-active-string bnd fun orig-buf)))
|
||
|
|
;;; (insert (format " Preferred is %s (`%s')': %s"
|
||
|
|
;;; txt fun act))
|
||
|
|
;;; (when bnd (insert active-mark) (setq act-found t))))
|
||
|
|
;;; (insert "\n\n")
|
||
|
|
(dolist (comp-fun tabkey2-completion-functions)
|
||
|
|
(let* ((txt (nth 0 comp-fun))
|
||
|
|
(fun (nth 1 comp-fun))
|
||
|
|
(chk (nth 2 comp-fun))
|
||
|
|
(bnd (with-current-buffer orig-buf
|
||
|
|
(tabkey2-is-active fun chk)))
|
||
|
|
(act (tabkey2-get-active-string bnd fun orig-buf))
|
||
|
|
(keys (where-is-internal fun)))
|
||
|
|
(if (not keys)
|
||
|
|
(setq keys "")
|
||
|
|
(setq keys (mapconcat 'key-description keys ", "))
|
||
|
|
(when (and (< 9 (length keys))
|
||
|
|
(string= "<menu-bar>" (substring keys 0 10)))
|
||
|
|
(setq keys "Menu"))
|
||
|
|
(setq keys (propertize keys 'face 'highlight))
|
||
|
|
(setq keys (concat ", " keys))
|
||
|
|
)
|
||
|
|
(insert
|
||
|
|
(format
|
||
|
|
" %s (`%s'%s): %s"
|
||
|
|
txt fun keys act))
|
||
|
|
(when (and (not act-found) bnd)
|
||
|
|
(insert active-mark) (setq act-found t))
|
||
|
|
(insert "\n")))
|
||
|
|
(insert "\n")
|
||
|
|
(if (not tabkey2-fallback)
|
||
|
|
(insert " There is no fallback")
|
||
|
|
(let* ((txt (nth 0 tabkey2-fallback))
|
||
|
|
(fun (nth 1 tabkey2-fallback))
|
||
|
|
(chk (nth 2 tabkey2-fallback))
|
||
|
|
(bnd (with-current-buffer orig-buf
|
||
|
|
(tabkey2-is-active fun chk)))
|
||
|
|
(act (tabkey2-get-active-string bnd fun orig-buf)))
|
||
|
|
(insert (format " Fallback is %s (`%s'): %s"
|
||
|
|
txt fun act))
|
||
|
|
(when (and (not act-found) bnd)
|
||
|
|
(insert active-mark)
|
||
|
|
(setq act-found t))))
|
||
|
|
(insert "\n\nYou an ")
|
||
|
|
(insert-text-button "customize this list"
|
||
|
|
'action (lambda (button)
|
||
|
|
(customize-option
|
||
|
|
'tabkey2-completion-functions)))
|
||
|
|
(insert ".\nSee function `tabkey2-mode' for more information.")
|
||
|
|
(with-no-warnings (print-help-return-message))))))
|
||
|
|
|
||
|
|
(defvar tabkey2-completing-read 'completing-read)
|
||
|
|
|
||
|
|
(defun tabkey2-set-fun (fun)
|
||
|
|
"Use function FUN for Tab in 'Tab completion state'."
|
||
|
|
(setq tabkey2-chosen-completion-function fun)
|
||
|
|
(unless fun
|
||
|
|
(setq fun (tabkey2-first-active-from-completion-functions)))
|
||
|
|
(tabkey2-make-message-and-set-fun fun)
|
||
|
|
(when (tabkey2-completion-state-p)
|
||
|
|
(message "%s" tabkey2-current-tab-info)))
|
||
|
|
|
||
|
|
(defun tabkey2-appmenu ()
|
||
|
|
"Make a menu for minor mode command `appmenu-mode'."
|
||
|
|
(unless (tabkey2-read-only-p)
|
||
|
|
(let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
|
||
|
|
(tit "Complete")
|
||
|
|
(map (make-sparse-keymap tit)))
|
||
|
|
(define-key map [tabkey2-usage]
|
||
|
|
(list 'menu-item "Show Available Completion Functions for TabKey2"
|
||
|
|
'tabkey2-show-completion-functions))
|
||
|
|
(define-key map [tabkey2-divider-1] (list 'menu-item "--"))
|
||
|
|
(let ((set-map (make-sparse-keymap "Set Completion")))
|
||
|
|
(define-key map [tabkey2-choose]
|
||
|
|
(list 'menu-item "Set Primary TabKey2 Tab Completion in Buffer" set-map))
|
||
|
|
(dolist (cf-rec cf-r)
|
||
|
|
(let ((dsc (nth 0 cf-rec))
|
||
|
|
(fun (nth 1 cf-rec)))
|
||
|
|
(define-key set-map
|
||
|
|
(vector (intern (format "tabkey2-set-%s" fun)))
|
||
|
|
(list 'menu-item dsc
|
||
|
|
`(lambda ()
|
||
|
|
(interactive)
|
||
|
|
(tabkey2-set-fun ',fun))
|
||
|
|
:button
|
||
|
|
`(:radio
|
||
|
|
. (eq ',fun tabkey2-chosen-completion-function))))))
|
||
|
|
(define-key set-map [tabkey2-set-div] (list 'menu-item "--"))
|
||
|
|
(define-key set-map [tabkey2-set-default]
|
||
|
|
(list 'menu-item "Default Tab completion"
|
||
|
|
(lambda ()
|
||
|
|
(interactive)
|
||
|
|
(tabkey2-set-fun nil))
|
||
|
|
:button
|
||
|
|
'(:radio . (null tabkey2-chosen-completion-function))))
|
||
|
|
(define-key set-map [tabkey2-set-header-div] (list 'menu-item "--"))
|
||
|
|
(define-key set-map [tabkey2-set-header]
|
||
|
|
(list 'menu-item "Set Primary Tab Completion for Buffer"))
|
||
|
|
)
|
||
|
|
(define-key map [tabkey2-divider] (list 'menu-item "--"))
|
||
|
|
(dolist (cf-rec cf-r)
|
||
|
|
(let ((dsc (nth 0 cf-rec))
|
||
|
|
(fun (nth 1 cf-rec)))
|
||
|
|
(define-key map
|
||
|
|
(vector (intern (format "tabkey2-call-%s" fun)))
|
||
|
|
(list 'menu-item dsc fun
|
||
|
|
:button
|
||
|
|
`(:toggle
|
||
|
|
. (eq ',fun tabkey2-chosen-completion-function))
|
||
|
|
))))
|
||
|
|
map)))
|
||
|
|
|
||
|
|
;; (defun tabkey2-completion-menu-popup ()
|
||
|
|
;; "Pop up a menu with completion alternatives."
|
||
|
|
;; (interactive)
|
||
|
|
;; (let ((menu (tabkey2-appmenu)))
|
||
|
|
;; (popup-menu-at-point menu)))
|
||
|
|
|
||
|
|
;; (defun tabkey2-choose-completion-function ()
|
||
|
|
;; "Set current completion function.
|
||
|
|
;; Let user choose completion function from those in
|
||
|
|
;; `tabkey2-completion-functions' that have some key binding at
|
||
|
|
;; point.
|
||
|
|
|
||
|
|
;; Let the chosen completion function be the default for subsequent
|
||
|
|
;; completions in the current buffer."
|
||
|
|
;; ;; Fix-me: adjust to mumamo.
|
||
|
|
;; (interactive)
|
||
|
|
;; (save-match-data
|
||
|
|
;; (if (and (featurep 'popcmp)
|
||
|
|
;; tabkey2-use-popup-menus)
|
||
|
|
;; (tabkey2-completion-menu-popup)
|
||
|
|
;; (when (eq 'completing-read tabkey2-completing-read) (isearch-unread 'tab))
|
||
|
|
;; (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
|
||
|
|
;; (cf (cons '("- Use default Tab completion" nil) cf-r))
|
||
|
|
;; (hist (mapcar (lambda (rec)
|
||
|
|
;; (car rec))
|
||
|
|
;; cf))
|
||
|
|
;; (tit (funcall tabkey2-completing-read "Set current completion function: " cf
|
||
|
|
;; nil ;; predicate
|
||
|
|
;; t ;; require-match
|
||
|
|
;; nil ;; initial-input
|
||
|
|
;; 'hist ;; hist
|
||
|
|
;; ))
|
||
|
|
;; (fun-rec (assoc-string tit cf))
|
||
|
|
;; (fun (cadr fun-rec)))
|
||
|
|
;; (setq tabkey2-chosen-completion-function fun)
|
||
|
|
;; (unless fun
|
||
|
|
;; (setq fun (tabkey2-first-active-from-completion-functions)))
|
||
|
|
;; (tabkey2-make-message-and-set-fun fun)
|
||
|
|
;; (when (tabkey2-completion-state-p)
|
||
|
|
;; (tabkey2-show-current-message))))))
|
||
|
|
|
||
|
|
;; (defun tabkey2-add-to-appmenu ()
|
||
|
|
;; "Add a menu to function `appmenu-mode'."
|
||
|
|
;; (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu))
|
||
|
|
|
||
|
|
|
||
|
|
(provide 'tabkey2)
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; tabkey2.el ends here
|