diff options
Diffstat (limited to 'emacs.d/nxhtml/util/tabkey2.el')
| -rw-r--r-- | emacs.d/nxhtml/util/tabkey2.el | 1701 |
1 files changed, 1701 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/tabkey2.el b/emacs.d/nxhtml/util/tabkey2.el new file mode 100644 index 0000000..d35e651 --- /dev/null +++ b/emacs.d/nxhtml/util/tabkey2.el @@ -0,0 +1,1701 @@ +;;; 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 |