emacs/nxhtml/util/tabkey2.el

   1 ;;; tabkey2.el --- Use second tab key pressed for what you want
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2008-03-15
   5 (defconst tabkey2:version "1.40")
   6 ;; Last-Updated: 2009-07-15 Wed
   7 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/tabkey2.el
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13   ;; `appmenu', `cl'.
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; The tab key is in Emacs often used for indentation.  However if you
  20 ;; press the tab key a second time and Emacs tries to do indentation
  21 ;; again, then usually nothing exciting will happen.  Then why not use
  22 ;; second tab key in a row for something else?
  23 ;;
  24 ;; Commonly used completion functions in Emacs is often bound to
  25 ;; something corresponding to Alt-Tab.  Unfortunately this is unusable
  26 ;; if you have a window manager that have an apetite for it (like that
  27 ;; on MS Windows for example, and several on GNU/Linux).
  28 ;;
  29 ;; Then using the second tab key press for completion might be a good
  30 ;; choice and perhaps also easy to remember.
  31 ;;
  32 ;; This little library tries to make it easy to do use the second tab
  33 ;; press for completion.  Or you can see this library as a swizz army
  34 ;; knife for the tab key ;-)
  35 ;;
  36 ;; See `tabkey2-mode' for more information.
  37 ;;
  38 ;;
  39 ;; This is a generalized of an idea Sebastien Rocca Serra once
  40 ;; presented on Emacs Wiki and called "Smart Tab".  (It seems like
  41 ;; many others have also been using Tab for completion in one way or
  42 ;; another for years.)
  43 ;;
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;
  46 ;;; Change log:
  47 ;;
  48 ;; Version 1.04:
  49 ;; - Add overlay to display state after first tab.
  50 ;;
  51 ;; Version 1.05:
  52 ;; - Fix remove overlay problem.
  53 ;;
  54 ;; Version 1.06:
  55 ;; - Add completion function choice.
  56 ;; - Add support for popcmp popup completion.
  57 ;;
  58 ;; Version 1.07:
  59 ;; - Add informational message after first tab.
  60 ;;
  61 ;; Version 1.08:
  62 ;; - Give better informational message after first tab.
  63 ;;
  64 ;; Version 1.09:
  65 ;; - Put flyspell first.
  66 ;;
  67 ;; Version 1.09:
  68 ;; - Give the overlay higher priority.
  69 ;;
  70 ;; Version 1.10:
  71 ;; - Correct tabkey2-completion-functions.
  72 ;; - Add double-tab for modes where tab can not be typed again.
  73 ;; - Use better condition for when completion can be done, so that it
  74 ;;   can be done later while still on the same line.
  75 ;; - Add a better message handling for the "Tab completion state".
  76 ;; - Add C-g break out of the "Tab completion state".
  77 ;; - Add faces for highlight.
  78 ;; - Make it work in custom mode buffers.
  79 ;; - Fix documentation for `tabkey2-first'
  80 ;;
  81 ;; Version 1.11:
  82 ;; - Don't call chosen completion function directly.  Instead make it
  83 ;;   default for current buffer.
  84 ;;
  85 ;; Version 1.12:
  86 ;; - Simplify code.
  87 ;; - Add help to C-f1 during "Tab completion state".
  88 ;; - Fix documentation basics.
  89 ;; - Add customization of state message and line marking.
  90 ;; - Fix handling of double-Tab modes.
  91 ;; - Make user interaction better.
  92 ;; - Handle read-only in custom buffers better.
  93 ;; - Add more flexible check for if completion function is active.
  94 ;; - Support predictive mode.
  95 ;; - Reorder and simplify.
  96 ;;
  97 ;; Version 1.13:
  98 ;; - Add org-mode to the double-tab gang.
  99 ;; - Make it possible to use double-tab in normal buffers.
 100 ;; - Add cycling through completion functions to S-tab.
 101 ;;
 102 ;; Version 1.14:
 103 ;; - Fix bug in handling of read-only.
 104 ;; - Show completion binding in help message.
 105 ;; - Add binding to make current choice buffer local when cycling.
 106 ;;
 107 ;; Version 1.15:
 108 ;; - Fix problem at buffer end.
 109 ;; - Add S-tab to enter completion state without indentation.
 110 ;; - Add backtab bindings too for this.
 111 ;; - Remove double-tab, S-tab is better.
 112 ;; - Add list of modes that uses more tabs.
 113 ;; - Add list of modes that uses tab only for completion.
 114 ;; - Move first overlay when indentation changes.
 115 ;; - Make mark at line beginning 1 char long.
 116 ;;
 117 ;; Version 1.16:
 118 ;; - Don't call tab function when alternate key is pressed.
 119 ;;
 120 ;; Version 1.17:
 121 ;; - Let alternate key cycle completion functions instead of complete.
 122 ;; - Bind backtab.
 123 ;; - Fix bug when only one completion funciton was available.
 124 ;; - Fix bug when alt key and major without fix indent.
 125 ;;
 126 ;; Version 1.18:
 127 ;; - Add popup style messages.
 128 ;; - Add delay to first message.
 129 ;; - Use different face for indicator on line and message.
 130 ;; - Use different face for echo area and popup messages.
 131 ;; - Add anything to completion functions.
 132 ;; - Put help funciton on f1.
 133 ;; - Always bind alternate key to cycle.
 134 ;; - Change defcustoms to simplify (excuse me).
 135 ;; - Work around end of buffer problems.
 136 ;; - Work around start of buffer problems.
 137 ;; - Assure popup messages are visible.
 138 ;; - Reorder code in more logical order.
 139 ;;
 140 ;; Version 1.19:
 141 ;; - Make overlay keymap end advance.
 142 ;; - Remove overlay keymap parent.
 143 ;;
 144 ;; Version 1.20:
 145 ;; - Fix bug on emtpy line.
 146 ;; - Fix some text problems.
 147 ;; - Make f1 c/k work in tab completion state.
 148 ;;
 149 ;; Version 1.20:
 150 ;; - Fixed bug in overlay removal.
 151 ;;
 152 ;; Version 1.21:
 153 ;; - Fixed bug in minibuffer setup.
 154 ;;
 155 ;; Version 1.22:
 156 ;; - Honour widget-forward, button-forward.
 157 ;;
 158 ;; Version 1.23:
 159 ;; - Remove binding of shift tab.
 160 ;; - Check if use-region-p is defined.
 161 ;;
 162 ;; Version 1.24:
 163 ;; - Add option for completion state mode line marker.
 164 ;; - Fix bug in tabkey2-show-completion-functions.
 165 ;; - Move off completion point cancels completion state.
 166 ;; - Fix bugs in help.
 167 ;; - Try to fix some problems with invisible text, at least in
 168 ;;   org-mode.
 169 ;; - Restore window config, completions often leaves without.
 170 ;;
 171 ;; Version 1.25:
 172 ;; - Fix bug in tabkey2-completion-state-p.
 173 ;;
 174 ;; Version 1.26:
 175 ;; - Make tabkey2-mode a buffer local mode.
 176 ;; - Add tabkey2-global-mode.
 177 ;; - Fix some bugs.
 178 ;;
 179 ;; Version 1.27:
 180 ;; - Fix some bugs in customization.
 181 ;;
 182 ;; Version 1.28:
 183 ;; - Use invisible-p.
 184 ;;
 185 ;; Version 1.29:
 186 ;; - Remove tabkey2-global-mode because of problem with minibuffers.
 187 ;;
 188 ;; Version 1.30:
 189 ;; - Add Semantic's smart completion to completion functions.
 190 ;;   (Thanks Eric.)
 191 ;;
 192 ;; Version 1.31:
 193 ;; - Add yasnippet and pabbrev completion functions. (Thanks Eric.)
 194 ;; - Reorder completion functions.
 195 ;;
 196 ;; Version 1.32:
 197 ;; - Add support for pcomplete.
 198 ;; - Inform about other key bindings in completion functions list.
 199 ;; - Remove no longer used "preferred" from completion functions list.
 200 ;;
 201 ;; Version 1.33:
 202 ;; -- Automatically select next function on completion failure.
 203 ;; -- Add completion functions reset functions.
 204 ;;
 205 ;; Version 1.34:
 206 ;; - Set this-command on call-interactively.
 207 ;; - Avoid setting last-command.
 208 ;;
 209 ;; Version 1.35:
 210 ;; - Do not complete in or nearby mumamo chunk borders.
 211 ;; - Finish completion mode unless last command was a tabkey2 command.
 212 ;; - Finish when there are no more active completion functions.
 213 ;;
 214 ;; Version 1.36:
 215 ;; - Actually check if completion function is a defined command.
 216 ;; - Integrate better with YASnippet.
 217 ;; - Give YASnippet higher priority since that seems what is wanted.
 218 ;;
 219 ;; Version 1.37:
 220 ;; - Fix bug revealed by 1.36 changes.
 221 ;;
 222 ;; Version 1.38:
 223 ;; - Fix typo in completion function list.
 224 ;; - Fix corresponding part of check if function is active.
 225 ;;
 226 ;; Version 1.39:
 227 ;; - Try first [tab] and then [?\t] when looking for command.
 228 ;;
 229 ;; Version 1.40:
 230 ;; - Added Company Mode completion.
 231 ;;
 232 ;; Fix-me: maybe add \\_>> option to behave like smart-tab. But this
 233 ;; will only works for modes that does not do completion of empty
 234 ;; words (like in smart-tab).
 235 ;;
 236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 237 ;;
 238 ;;; Known bugs
 239 ;;
 240 ;; - Maybe problems with comint shell.
 241 ;; - Does not check visibility very carefully.
 242 ;;
 243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 244 ;;
 245 ;; This program is free software; you can redistribute it and/or
 246 ;; modify it under the terms of the GNU General Public License as
 247 ;; published by the Free Software Foundation; either version 2, or
 248 ;; (at your option) any later version.
 249 ;;
 250 ;; This program is distributed in the hope that it will be useful,
 251 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 252 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 253 ;; General Public License for more details.
 254 ;;
 255 ;; You should have received a copy of the GNU General Public License
 256 ;; along with this program; see the file COPYING.  If not, write to
 257 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 258 ;; Floor, Boston, MA 02110-1301, USA.
 259 ;;
 260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 261 ;;
 262 ;;; Code:
 263
 264 (eval-when-compile (require 'cl))
 265 (eval-when-compile (require 'appmenu nil t))
 266 (eval-when-compile (require 'mumamo nil t))
 267
 268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 269 ;;;; Custom
 270
 271 ;;;###autoload
 272 (defgroup tabkey2 nil
 273   "Customization of second tab key press."
 274   :group 'nxhtml
 275   :group 'convenience)
 276
 277 (defface tabkey2-highlight-line
 278   '((t :inherit highlight))
 279   "Face for marker on line when default function is active."
 280   :group 'tabkey2)
 281
 282 (defface tabkey2-highlight-line2
 283   '((t :inherit isearch-fail))
 284   "Face for marker on line when non-default function is active."
 285   :group 'tabkey2)
 286
 287 (defface tabkey2-highlight-message
 288   '((t :inherit tabkey2-highlight-line))
 289   "Face for messages in echo area."
 290   :group 'tabkey2)
 291
 292 (defface tabkey2-highlight-popup
 293   '((default :box t :inherit tabkey2-highlight-message)
 294     (((class color) (background light)) :foreground "black")
 295     (((class color) (background dark)) :foreground "yellow"))
 296   "Face for popup messages."
 297   :group 'tabkey2)
 298
 299 (defcustom tabkey2-show-mark-on-active-line t
 300   "Show mark on active line if non-nil.
 301 This mark is shown during 'Tab completion state'."
 302   :type 'boolean
 303   :group 'tabkey2)
 304
 305 (defvar tabkey2-completion-lighter nil)
 306 (defcustom tabkey2-completion-lighter-on nil
 307   "Mode line lighter for function `tabkey2-completion-state-mode'."
 308   :type 'boolean
 309   :set (lambda (symbol value)
 310          (set-default symbol value)
 311          (setq tabkey2-completion-lighter (if value " Tab2" nil))
 312          (setq minor-mode-alist
 313                (assq-delete-all 'tabkey2-completion-state-mode
 314                                 minor-mode-alist)))
 315   :group 'tabkey2)
 316
 317 (defcustom tabkey2-show-message-on-enter 2.0
 318   "If non-nil show message when entering 'Tab completion state'.
 319 If value is a number then delay message that number of seconds."
 320   :type '(choice (const :tag "Don't show" nil)
 321                  (const :tag "Show at once" t)
 322                  (float :tag "Show, but delayed (seconds)"))
 323   :group 'tabkey2)
 324
 325
 326 ;; (setq tabkey2-message-style 'popup)
 327 ;; (setq tabkey2-message-style 'echo-area)
 328 (defcustom tabkey2-message-style 'popup
 329   "How to show messages."
 330   :type '(choice (const :tag "Popup" popup)
 331                  (const :tag "Echo area" echo-area))
 332   :group 'tabkey2)
 333
 334 (defcustom tabkey2-in-minibuffer nil
 335   "If non-nil use command `tabkey2-mode' also in minibuffer."
 336   :type 'boolean
 337   :group 'tabkey2)
 338
 339 (defcustom tabkey2-in-appmenu t
 340   "Show a completion menu in command `appmenu-mode' if t."
 341   :type 'boolean
 342   :set (lambda (sym val)
 343          (set-default sym val)
 344          (when (fboundp 'appmenu-add)
 345            (if val
 346                (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu)
 347              (appmenu-remove 'tabkey2))))
 348   :group 'tabkey2)
 349
 350 (defun yas/expandable-at-point ()
 351   "Return non-nil if a snippet can be expanded here."
 352   (when (and (fboundp 'yas/template-condition-predicate)
 353              (boundp 'yas/buffer-local-condition))
 354     (yas/template-condition-predicate
 355      yas/buffer-local-condition)))
 356
 357 (defvar tabkey2-company-backends
 358   "List of frontends and their backends."
 359   '((company-mode (NONE                   company-abbrev . "Abbrev")
 360                   (NONE                   company-css . "CSS")
 361                   (dabbrev-expan          company-dabbrev . "dabbrev for plain text")
 362                   (NONE                   company-dabbrev-code . "dabbrev for code")
 363                   (NONE                   company-eclim . "eclim (an Eclipse interace)")
 364                   (lisp-symbol-complete   company-elisp . "Emacs Lisp")
 365                   (complete-tag           company-etags . "etags")
 366                   (NONE                   company-files . "Files")
 367                   (NONE                   company-gtags . "GNU Global")
 368                   (ispell-complete-word   company-ispell . "ispell")
 369                   (flyspell-correct-word-before-point company-ispell . "ispell")
 370                   (NONE                   company-keywords . "Programming language keywords")
 371                   (nxml-complete          company-nxml . "nxml")
 372                   (NONE                   company-oddmuse . "Oddmuse")
 373                   (NONE                   company-pysmell . "PySmell")
 374                   (NONE                   company-ropemacs . "ropemacs")
 375                   (senator-complete-symbol company-semantic . "CEDET Semantic")
 376                   (NONE                   company-tempo . "Tempo templates")
 377                   (NONE                   company-xcode . "Xcode"))))
 378
 379 (defun tabkey2-find-front-end (fun)
 380   (let ((
 381          ))))
 382
 383 (defcustom tabkey2-completion-functions
 384   '(
 385     ;; Front ends (should take care of the rest, ie temporary things,
 386     ;; snippets etc...)
 387     ("Company Mode completion" company-complete company-mode)
 388     ;; Temporary things
 389     ("Spell check word" flyspell-correct-word-before-point)
 390     ;; Snippets
 391     ("Yasnippet" yas/expand (yas/expandable-at-point))
 392     ;; Main mode related, often used
 393     ("Semantic Smart Completion" senator-complete-symbol senator-minor-mode)
 394     ("Programmable completion" pcomplete)
 395     ("nXML completion" nxml-complete)
 396     ("Complete Emacs symbol" lisp-complete-symbol)
 397     ("Widget complete" widget-complete)
 398     ("Comint Dynamic Complete" comint-dynamic-complete)
 399     ("PHP completion" php-complete-function)
 400     ("Tags completion" complete-tag)
 401     ;; General word completion
 402     ("Predictive word" complete-word-at-point predictive-mode)
 403     ("Predictive abbreviations" pabbrev-expand-maybe)
 404     ("Dynamic word expansion" dabbrev-expand nil (setq dabbrev--last-abbrev-location nil))
 405     ("Ispell complete word" ispell-complete-word)
 406     ;; The catch all
 407     ("Anything" anything (commandp 'anything))
 408     )
 409   "List of completion functions.
 410 The first 'active' entry in this list is normally used during the
 411 'Tab completion state' by `tabkey2-complete'.  An entry in the
 412 list should have either of this forms
 413
 414   \(TITLE COMPLETION-FUNCTION ACTIVE-FORM RESET-FORM)
 415
 416 TITLE to show in menus etc.
 417
 418 COMPLETION-FUNCTION is the completion function symbol.
 419
 420 The entry is considered active if the symbol COMPLETION-FUNCTION
 421 is bound to a command and
 422
 423   - This function has a key binding at point.
 424
 425 or
 426
 427   - The elisp expression ACTIVE-FORM evaluates to non-nil.  If it
 428   is a single symbol then its variable value is used, otherwise
 429   the elisp form is evaled.
 430
 431 RESET-FORM is used to reset the completion function before
 432 calling it.
 433
 434 When choosing with `tabkey2-cycle-completion-functions'
 435 only the currently active entry in this list are shown."
 436   :type '(repeat (list string (choice (command :tag "Currently known command")
 437                                       (symbol  :tag "Command not known yet"))
 438                        (choice (const :tag "Active only if it has a key binding at point" nil)
 439                                (sexp :tag "Elisp, if evals to non-nil then active"))
 440                        (sexp :tag "Elisp, reset completion function")))
 441   :group 'tabkey2)
 442
 443 ;; Use emulation mode map for first Tab key
 444 (defconst tabkey2-mode-emul-map (make-sparse-keymap)
 445   "This keymap just binds tab and alternate key all the time.
 446 By default this binds Tab to `tabkey2-first'.  The actual keys
 447 bound are in `tabkey2-first-key' and `tabkey2-alternate-key'.")
 448
 449 (defvar tabkey2--emul-keymap-alist nil)
 450
 451 ;; (setq tabkey2-keymap-overlay nil)
 452 (defconst tabkey2-completion-state-emul-map
 453   (let ((map (make-sparse-keymap)))
 454     (define-key map [(control ?c) tab]    'tabkey2-make-current-default)
 455
 456     ;;(define-key map tabkey2-alternate-key 'tabkey2-cycle-completion-functions)
 457     (define-key map [backtab]             'tabkey2-cycle-completion-functions)
 458
 459     (define-key map [(control f1)]        'tabkey2-completion-function-help)
 460     (define-key map [(meta f1)]           'tabkey2-show-completion-functions)
 461     (define-key map [f1]                  'tabkey2-completion-state-help)
 462
 463     (define-key map [(control ?g)]        'tabkey2-completion-state-off)
 464     (define-key map [tab]                 'tabkey2-complete)
 465     map)
 466   "This keymap is for `tabkey2-keymap-overlay'.")
 467
 468 (defun tabkey2-bind-keys (first-key alternate-key)
 469   (let ((mode-map tabkey2-mode-emul-map)
 470         (comp-map tabkey2-completion-state-emul-map))
 471     ;; First key
 472     (when (and (boundp 'tabkey2-first-key)
 473                tabkey2-first-key)
 474       (define-key mode-map tabkey2-first-key nil))
 475     (when first-key
 476       (define-key mode-map first-key 'tabkey2-first))
 477     ;; Alternate key
 478     (when (and (boundp 'tabkey2-alternate-key)
 479                tabkey2-alternate-key)
 480       (define-key mode-map tabkey2-alternate-key nil)
 481       (define-key comp-map tabkey2-alternate-key nil))
 482     (when alternate-key
 483       (define-key mode-map alternate-key 'tabkey2-cycle-completion-functions)
 484       (define-key comp-map alternate-key 'tabkey2-cycle-completion-functions))
 485     (when (and (boundp 'tabkey2-completion-state-mode)
 486                tabkey2-completion-state-mode)
 487       (tabkey2-completion-state-mode -1)
 488       (tabkey2-completion-state-mode 1))))
 489
 490 (defcustom tabkey2-first-key [tab]
 491   "First key, first time indents, more invocations completes.
 492 This key is always bound to `tabkey2-first'."
 493   :set (lambda (sym val)
 494          (set-default sym val)
 495          (tabkey2-bind-keys
 496           val
 497           (when (boundp 'tabkey2-alternate-key)
 498             tabkey2-alternate-key)))
 499   :type 'key-sequence
 500   :group 'tabkey2)
 501
 502 (defcustom tabkey2-alternate-key [f8]
 503   "Alternate key, bound to cycle and show completion functions.
 504 This key is always bound to `tabkey2-cycle-completion-functions'."
 505   :set (lambda (sym val)
 506          (set-default sym val)
 507          (tabkey2-bind-keys (when (boundp 'tabkey2-first-key) tabkey2-first-key) val))
 508   :type 'key-sequence
 509   :group 'tabkey2)
 510
 511 (tabkey2-bind-keys tabkey2-first-key tabkey2-alternate-key)
 512
 513 ;;;###autoload
 514 (define-minor-mode tabkey2-mode
 515   "More fun with Tab key number two (completion etc).
 516 This global minor mode by default binds Tab in a way that let you
 517 do completion with Tab in all buffers \(where it is possible).
 518
 519 The Tab key is easy to type on your keyboard.  Then why not use
 520 it for completion, something that is very useful?  Shells usually
 521 use Tab for completion so many are used to it.  This was the idea
 522 of Smart Tabs and this is a generalization of that idea.
 523
 524 However in Emacs the Tab key is usually used for indentation.
 525 The idea here is that if Tab has been pressed once for
 526 indentation, then as long as point stays further Tab keys might
 527 as well do completion.
 528
 529 So you kind of do Tab-Tab for first completion \(and then just
 530 Tab for further completions as long as point is not moved).
 531
 532 And there is even kind of Tab-Tab-Tab completion: If completion
 533 fails the next completion function will be the one you try with
 534 next Tab. \(You get some notification of this, of course.)
 535
 536 See `tabkey2-first' for more information about usage.
 537
 538 Note: If you do not want the Tab-Tab behaviour above, but still
 539 want an easy way to reach the available completion functions,
 540 then you can instead of turning on tabkey2-mode enter this in
 541 your .emacs:
 542
 543  \(global-set-key [f8] 'tabkey2-cycle-completion-functions)
 544
 545 After hitting f8 you will then be in the same state as after the
 546 first in tabkey2-mode."
 547   :keymap nil
 548   :global t
 549   :group 'tabkey2
 550   (if tabkey2-mode
 551       (progn
 552         (add-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
 553         (add-hook 'post-command-hook 'tabkey2-post-command)
 554         ;; Update emul here if keymap have changed
 555         (setq tabkey2--emul-keymap-alist
 556               (list (cons 'tabkey2-mode
 557                           tabkey2-mode-emul-map)))
 558         (add-to-list 'emulation-mode-map-alists 'tabkey2--emul-keymap-alist))
 559     (tabkey2-completion-state-mode -1)
 560     (remove-hook 'post-command-hook 'tabkey2-post-command)
 561     (remove-hook 'minibuffer-setup-hook 'tabkey2-minibuffer-setup)
 562     (setq emulation-mode-map-alists (delq 'tabkey2--emul-keymap-alist
 563                                           emulation-mode-map-alists))))
 564
 565 (defcustom tabkey2-modes-that-use-more-tabs
 566   '(python-mode
 567     haskell-mode
 568     makefile-mode
 569     org-mode
 570     Custom-mode
 571     custom-mode ;; For Emacs 22
 572     ;; other
 573     cmd-mode
 574     )
 575   "In those modes use must use S-Tab to start completion state.
 576 In those modes pressing Tab several types may make sense so you
 577 can not go into 'Tab completion state' just because one Tab has
 578 been pressed.  Instead you use S-Tab to go into that state.
 579 After that Tab does completion.
 580
 581 You can do use S-Tab in other modes too if you want too."
 582   :type '(repeat (choice (command :tag "Currently known command")
 583                          (symbol  :tag "Command not known yet")))
 584   :group 'tabkey2)
 585
 586 (defcustom tabkey2-modes-that-just-complete
 587   '(shell-mode
 588     fundamental-mode
 589     text-mode)
 590   "Tab is only used for completion in these modes.
 591 Therefore `tabkey2-first' just calls the function on Tab."
 592   :type '(repeat (choice (command :tag "Currently known command")
 593                          (symbol  :tag "Command not known yet")))
 594   :group 'tabkey2)
 595
 596 ;;(setq tabkey2-use-popup-menus nil)
 597 ;; (defcustom tabkey2-use-popup-menus (when (featurep 'popcmp) t)
 598 ;;   "Use pop menus if available."
 599 ;;   :type 'boolean
 600 ;;   :group 'tabkey2)
 601
 602 ;; (defvar tabkey2-preferred nil
 603 ;;   "Preferred function for second tab key press.")
 604 ;; (make-variable-buffer-local 'tabkey2-preferred)
 605 ;; (put 'tabkey2-preferred 'permanent-local t)
 606
 607 (defvar tabkey2-fallback nil
 608   "Fallback function for second tab key press.")
 609 (make-variable-buffer-local 'tabkey2-fallback)
 610 (put 'tabkey2-fallback 'permanent-local t)
 611
 612
 613 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 614 ;;;; State
 615
 616 (defvar tabkey2-overlay nil
 617   "Show when tab key 2 action is to be done.")
 618 (defvar tabkey2-keymap-overlay nil
 619   "Hold the keymap for tab key 2.")
 620
 621 (defvar tabkey2-current-tab-info nil
 622   "Saved information message for Tab completion state.")
 623 (defvar tabkey2-current-tab-function nil
 624   "Tab completion state current completion function.")
 625 (make-variable-buffer-local 'tabkey2-current-tab-function)
 626
 627 (defun tabkey2-completion-state-p ()
 628   "Return t if Tab completion state should continue.
 629 Otherwise return nil."
 630   (when (and (eq (current-buffer) (overlay-buffer tabkey2-keymap-overlay))
 631              (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window)))
 632     (let* ((start (overlay-start tabkey2-keymap-overlay))
 633            (end   (overlay-end   tabkey2-keymap-overlay))
 634            (chars (append (buffer-substring-no-properties start end) nil)))
 635       (and (not (memq ?\n chars))
 636            (not (eq ?\  (car (last chars))))
 637            (not (eq ?\  last-input-event))
 638            (<= start (point))
 639            (<= (point) end)
 640            tabkey2-current-tab-function
 641            (or (memq this-original-command '(tabkey2-first tabkey2-complete))
 642                (let* ((last-name (symbol-name this-original-command))
 643                       (name-prefix "tabkey2-")
 644                       (prefix-len (length name-prefix)))
 645                  (and (> (length last-name) prefix-len)
 646                       (string= name-prefix (substring last-name 0 prefix-len)))))
 647            ))))
 648
 649 (defun tabkey2-read-only-p ()
 650   "Return non-nil if buffer seems to be read-only at point."
 651   (or buffer-read-only
 652       (get-char-property (min (+ 0 (point)) (point-max)) 'read-only)
 653       (let ((remap (command-remapping 'self-insert-command (point))))
 654         (memq remap '(Custom-no-edit)))))
 655
 656 ;;;; Minor mode active after first tab
 657
 658 (defun tabkey2-get-highlight-face ()
 659   (if (eq tabkey2-current-tab-function
 660           (tabkey2-first-active-from-completion-functions))
 661       'tabkey2-highlight-line
 662     'tabkey2-highlight-line2))
 663
 664 (defun tabkey2-move-overlays ()
 665   "Move overlays that mark the state and carries the state keymap."
 666   (let* ((beg (let ((inhibit-field-text-motion t))
 667                 (line-beginning-position)))
 668          (ind (current-indentation))
 669          (end (+ beg 1)) ;(if (> ind 0) ind 1)))
 670          (inhibit-read-only t))
 671     (unless tabkey2-overlay
 672       (setq tabkey2-overlay (make-overlay beg end)))
 673     ;; Fix-me: gets some strange errors, try avoid moving:
 674     (unless (and (eq (current-buffer) (overlay-buffer tabkey2-overlay))
 675                  (= beg (overlay-start tabkey2-overlay))
 676                  (= end (overlay-end   tabkey2-overlay)))
 677       (move-overlay tabkey2-overlay beg end (current-buffer)))
 678     ;; Give it a high priority, it is very temporary
 679     (overlay-put tabkey2-overlay 'priority 1000)
 680     (if tabkey2-show-mark-on-active-line
 681         (progn
 682           (overlay-put tabkey2-overlay 'face
 683                        ;;'tabkey2-highlight-line
 684                        (tabkey2-get-highlight-face)
 685                        )
 686           (overlay-put tabkey2-overlay 'help-echo
 687                        "This highlight shows that Tab completion state is on"))
 688       (overlay-put tabkey2-overlay 'face nil)
 689       (overlay-put tabkey2-overlay 'help-echo nil)))
 690   ;; The keymap overlay
 691   (let ((beg (line-beginning-position))
 692         (end (line-end-position)))
 693     ;;(when (= end (point-max)) (setq end (1+ end)))
 694     (setq beg (point))
 695     (setq end (point))
 696
 697     (unless tabkey2-keymap-overlay
 698       ;; Make the rear of the overlay advance so that the keymap works
 699       ;; at the end of a line and the end of the buffer.
 700       (setq tabkey2-keymap-overlay (make-overlay 0 0 nil nil t)))
 701     (overlay-put tabkey2-keymap-overlay 'priority 1000)
 702     ;;(overlay-put tabkey2-keymap-overlay 'face 'secondary-selection)
 703     (overlay-put tabkey2-keymap-overlay 'keymap
 704                  tabkey2-completion-state-emul-map)
 705     (overlay-put tabkey2-keymap-overlay 'window (selected-window))
 706     (move-overlay tabkey2-keymap-overlay beg end (current-buffer))))
 707
 708 (defun tabkey2-is-active (fun chk)
 709   "Return t FUN is active.
 710 Return t if CHK is a symbol with non-nil value or a form that
 711 evals to non-nil.
 712
 713 Otherwise return t if FUN has a key binding at point."
 714   (when (and (fboundp fun)
 715              (commandp fun))
 716     (or (if (symbolp chk)
 717             (when (boundp chk) (symbol-value chk))
 718           (eval chk))
 719         (let* ((emulation-mode-map-alists
 720                 ;; Remove keymaps from tabkey2 in this copy:
 721                 (delq 'tabkey2--emul-keymap-alist
 722                       (copy-sequence emulation-mode-map-alists)))
 723                (keys (tabkey2-symbol-keys fun))
 724                kb-bound)
 725           (dolist (key keys)
 726             (unless (memq (car (append key nil))
 727                           '(menu-bar))
 728               (setq kb-bound t)))
 729           kb-bound))))
 730
 731 (defun tabkey2-is-active-p (fun)
 732   "Return FUN is active.
 733 Look it up in `tabkey2-completion-functions' to find out what to
 734 check and return the value from `tabkey2-is-active'."
 735   (let ((chk (catch 'chk
 736                (dolist (rec tabkey2-completion-functions)
 737                  (when (eq fun (nth 1 rec))
 738                    (throw 'chk (nth 2 rec)))))))
 739     (tabkey2-is-active fun chk)))
 740
 741 (defvar tabkey2-chosen-completion-function nil)
 742 (make-variable-buffer-local 'tabkey2-chosen-completion-function)
 743 (put 'tabkey2-chosen-completion-function 'permanent-local t)
 744
 745 (defun tabkey2-first-active-from-completion-functions ()
 746   "Return first active completion function.
 747 Look in `tabkey2-completion-functions' for the first function
 748 that has an active key binding."
 749   (catch 'active-fun
 750     (dolist (rec tabkey2-completion-functions)
 751       (let ((fun (nth 1 rec))
 752             (chk (nth 2 rec)))
 753         (when (tabkey2-is-active fun chk)
 754           (throw 'active-fun fun))))))
 755
 756 (defun tabkey2-get-default-completion-fun ()
 757   "Return the default completion function.
 758 See `tabkey2-first' for the list considered."
 759   (or (when (and tabkey2-chosen-completion-function
 760                  (tabkey2-is-active-p
 761                   tabkey2-chosen-completion-function))
 762         tabkey2-chosen-completion-function)
 763       ;;tabkey2-preferred
 764       (tabkey2-first-active-from-completion-functions)
 765       tabkey2-fallback))
 766
 767 (defvar tabkey2-overlay-message nil)
 768
 769 (defvar tabkey2-completion-state-mode nil)
 770 ;;(make-variable-buffer-local 'tabkey2-completion-state-mode)
 771 (defun tabkey2-completion-state-mode (arg)
 772   "Tab completion state minor mode.
 773 This pseudo-minor mode holds the 'Tab completion state'.  When this
 774 minor mode is on completion key bindings are available.
 775
 776 With ARG a positive number turn on, otherwise turn off this minor
 777 mode.
 778
 779 See `tabkey2-first' for more information."
 780   ;;(assq-delete-all 'tabkey2-completion-state-mode minor-mode-alist)
 781   (unless (assoc 'tabkey2-completion-state-mode minor-mode-alist)
 782     ;;(setq minor-mode-alist (cons '(tabkey2-completion-state-mode " Tab2")
 783     (setq minor-mode-alist (cons (list 'tabkey2-completion-state-mode
 784                                        tabkey2-completion-lighter)
 785                                  minor-mode-alist)))
 786   (let ((emul-map (cdr (car tabkey2--emul-keymap-alist)))
 787         (old-wincfg tabkey2-completion-state-mode))
 788     (setq tabkey2-completion-state-mode (when (and (numberp arg)
 789                                                    (> arg 0))
 790                                           ;;t
 791                                           (current-window-configuration)
 792                                           ))
 793     (if tabkey2-completion-state-mode
 794         (progn
 795           ;; Set default completion function
 796           (tabkey2-make-message-and-set-fun
 797            (tabkey2-get-default-completion-fun))
 798           ;; Message
 799           ;;(setq tabkey2-message-is-shown nil)
 800           (when tabkey2-show-message-on-enter
 801             (tabkey2-show-current-message
 802              (when (numberp tabkey2-show-message-on-enter)
 803                tabkey2-show-message-on-enter)))
 804           ;; Move overlays
 805           (tabkey2-move-overlays)
 806           ;; Work around eob keymap problem ...
 807           ;;(set-keymap-parent emul-map (overlay-get tabkey2-keymap-overlay
 808           ;;                                         'keymap))
 809           ;; Set up for pre/post-command-hook
 810           (add-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
 811           (add-hook 'post-command-hook 'tabkey2-completion-state-post-command))
 812       ;;(set-keymap-parent emul-map nil)
 813       (setq tabkey2-current-tab-function nil)
 814       (when (and old-wincfg
 815                  tabkey2-keymap-overlay
 816                  (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
 817                  (not (active-minibuffer-window)))
 818         (set-window-configuration old-wincfg))
 819       (let ((inhibit-read-only t))
 820         (when tabkey2-keymap-overlay
 821           (delete-overlay tabkey2-keymap-overlay))
 822         (when tabkey2-overlay
 823           (delete-overlay tabkey2-overlay)))
 824       (remove-hook 'pre-command-hook 'tabkey2-completion-state-pre-command)
 825       (remove-hook 'post-command-hook 'tabkey2-completion-state-post-command)
 826       (tabkey2-overlay-message nil)
 827       ;;(message "")
 828       )))
 829
 830 (defun tabkey2-completion-state-off ()
 831   "Quit Tab completion state."
 832   (interactive)
 833   (tabkey2-completion-state-mode -1)
 834   (let ((C-g-binding (or (key-binding [(control ?g)])
 835                          (key-binding "\C-g")))
 836         did-more)
 837     (when (and (boundp 'company-mode)
 838                company-mode)
 839       ;;(message "tabkey2:company-abort")
 840       (company-abort)
 841       (setq did-more t))
 842     (when (and C-g-binding
 843              (not (eq C-g-binding this-command)))
 844         ;;(message "tabkey2:c-g=%s" C-g-binding)
 845         (call-interactively C-g-binding)
 846         (setq did-more t))
 847     (message "Quit")))
 848
 849 (defvar tabkey2-message-is-shown nil)
 850 (defun tabkey2-message-is-shown ()
 851   (case tabkey2-message-style
 852     ('popup
 853      (when tabkey2-overlay-message
 854        (overlay-buffer tabkey2-overlay-message)))
 855     ('echo-area
 856      (get (current-message) 'tabkey2))))
 857
 858 (defun tabkey2-completion-state-pre-command ()
 859   "Run this in `pre-command-hook'.
 860 Check if message is shown.
 861 Remove overlay message.
 862 Cancel delayed message."
 863   ;;(message "=====> tabkey2-completion-state-pre-command")
 864   (condition-case err
 865       (progn
 866         (setq tabkey2-message-is-shown (tabkey2-message-is-shown))
 867         ;;(message "tabkey2-overlay-message=%s, is-shown=%s" tabkey2-overlay-message tabkey2-message-is-shown)
 868         (tabkey2-overlay-message nil)
 869         (tabkey2-cancel-delayed-message)
 870         ;;(message "here buffer=%s, this-command=%s" (current-buffer) this-command)
 871         )
 872     (error (message "tabkey2 pre: %s" (error-message-string err)))))
 873
 874 (defun tabkey2-completion-state-post-command ()
 875   "Turn off Tab completion state if not feasable any more.
 876 This is run in `post-command-hook' after each command."
 877   (condition-case err
 878       ;;(save-match-data
 879         ;; Delayed messages
 880         (if (not (tabkey2-completion-state-p))
 881             (tabkey2-completion-state-mode -1)
 882           ;;(message "tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
 883           (tabkey2-move-overlays))
 884     ;;)
 885     (error (message "tabkey2 post: %s" (error-message-string err)))))
 886
 887 (defun tabkey2-minibuffer-setup ()
 888   "Activate/deactivate function `tabkey2-mode' in minibuffer."
 889   (set (make-local-variable 'tabkey2-mode)
 890        (and tabkey2-mode
 891             tabkey2-in-minibuffer))
 892   (unless tabkey2-mode
 893     (set (make-local-variable 'emulation-mode-map-alists)
 894          (delq 'tabkey2--emul-keymap-alist
 895                (copy-sequence emulation-mode-map-alists)))))
 896
 897
 898 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 899 ;;;; Message functions
 900
 901 ;; Fix-me: Included in Emacs 23.
 902 (unless (fboundp 'invisible-p)
 903   (defun invisible-p (pos)
 904     "Return non-nil if the character after POS is currently invisible."
 905     (let ((prop
 906            (get-char-property pos 'invisible)))
 907       (if (eq buffer-invisibility-spec t)
 908           prop
 909         (if (listp prop)
 910             (catch 'invis
 911               (dolist (p prop)
 912                 (when (or (memq p buffer-invisibility-spec)
 913                           (assq p buffer-invisibility-spec))
 914                   (throw 'invis t))))
 915           (or (memq prop buffer-invisibility-spec)
 916               (assq prop buffer-invisibility-spec)))))))
 917
 918 ;; (defun test-scroll ()
 919 ;;   (interactive)
 920 ;;   (setq debug-on-error t)
 921 ;;   (let* ((buffer-name "test-scroll")
 922 ;;         (buffer (get-buffer buffer-name)))
 923 ;;     (when buffer (kill-buffer buffer))
 924 ;;     (setq buffer (get-buffer-create buffer-name))
 925 ;;     (switch-to-buffer buffer)
 926 ;;     (message "here 1") (sit-for 1)
 927 ;;     (condition-case err
 928 ;;         (scroll-up 1)
 929 ;;       (error (message "scroll-up error: %s" err)
 930 ;;              (sit-for 1)))
 931 ;;     (message "here 2") (sit-for 1)
 932 ;;     (scroll-up 1)
 933 ;;     (message "here 3") (sit-for 1)
 934 ;;     ))
 935
 936 (defun tabkey2-overlay-message (txt)
 937   "Display TXT below or above current line using an overlay."
 938   ;;(setq tabkey2-message-is-shown txt)
 939   (if (not txt)
 940       (when tabkey2-overlay-message
 941         (delete-overlay tabkey2-overlay-message)
 942         (setq tabkey2-overlay-message nil))
 943     (let ((ovl tabkey2-overlay-message)
 944           (column (current-column))
 945           (txt-len (length txt))
 946           (here (point))
 947           beg end
 948           (before "")
 949           (after "")
 950           ovl-str too-much
 951           (is-eob (eobp))
 952           (direction 1))
 953       (unless ovl (setq ovl (make-overlay 0 0)))
 954       (when tabkey2-overlay-message
 955         (delete-overlay tabkey2-overlay-message))
 956       (setq tabkey2-overlay-message ovl)
 957
 958       (when is-eob
 959         (setq direction -1))
 960       (when (and (/= (point-min) (window-start))
 961                  (not (pos-visible-in-window-p (min (point-max) (1+ (line-end-position))))))
 962         ;; Go back inside window to avoid aggressive scrolling:
 963         (forward-line -1)
 964         (scroll-up 1)
 965         (forward-line 1))
 966       (forward-line direction)
 967       ;; Fix-me: Emacs bug workaround
 968       (if (when (< 1 (point))
 969             (invisible-p (1- (line-end-position))))
 970           (progn
 971             (goto-char here)
 972             (tabkey2-echo-area-message txt))
 973         ;; Fix-me: Does this really do anything now:
 974         (when (invisible-p (point))
 975           (while (invisible-p (point))
 976             (forward-line direction)))
 977         (setq beg (line-beginning-position))
 978         (setq end (line-end-position))
 979
 980         (if (or (invisible-p beg) (invisible-p end))
 981           ;; Give up, do not fight invisibility:
 982             (progn
 983               (tabkey2-overlay-message nil)
 984               (tabkey2-echo-area-message txt))
 985
 986           ;; string before
 987           (move-to-column column)
 988           (setq before (buffer-substring beg (point)))
 989           (when (< (current-column) column)
 990             (setq before
 991                   (concat before
 992                           (make-string (- column (current-column)) ? ))))
 993           (setq too-much (- (+ 1 txt-len (length before))
 994                             (window-width)))
 995           (when (> too-much 0)
 996             (setq before (substring before 0 (- too-much))))
 997
 998           (unless (> too-much 0)
 999             (move-to-column (+ txt-len (length before)))
1000             (setq after (buffer-substring (point) end)))
1001
1002           (setq ovl-str (concat before
1003                                 (propertize txt 'face 'tabkey2-highlight-popup)
1004                                 after
1005                                 ))
1006
1007           (overlay-put ovl 'after-string ovl-str)
1008           (overlay-put ovl 'display "")
1009           (overlay-put ovl 'window (selected-window))
1010           (move-overlay ovl beg end (current-buffer)))
1011
1012         (goto-char here)
1013         ))))
1014
1015 ;; Fix-me: This was not usable IMO. Too much flickering.
1016 ;; (defun tabkey2-tooltip (txt)
1017 ;;   (let* ((params tooltip-frame-parameters)
1018 ;;          (coord (car (point-to-coord (point))))
1019 ;;          (left (car coord))
1020 ;;          (top  (cadr coord))
1021 ;;          tooltip-frame-parameters
1022 ;;          )
1023 ;;     ;; Fix-me: how do you get char height??
1024 ;;     (setq top (+ top 50))
1025 ;;     (setq params (tooltip-set-param params 'left left))
1026 ;;     (setq params (tooltip-set-param params 'top top))
1027 ;;     (setq params (tooltip-set-param params 'top top))
1028 ;;     (setq tooltip-frame-parameters params)
1029 ;;     (tooltip-hide)
1030 ;;     (tooltip-show txt nil)))
1031
1032 (defun tabkey2-echo-area-message (txt)
1033   "Show TXT in the echo area with a special face.
1034 Shown with the face `tabkey2-highlight-message'."
1035   (message "%s" (propertize txt
1036                             'face 'tabkey2-highlight-message
1037                             'tabkey2 t)))
1038
1039 (defun tabkey2-deliver-message (txt)
1040   "Show message TXT to user."
1041   (case tabkey2-message-style
1042     (popup (tabkey2-overlay-message txt))
1043     (t (tabkey2-echo-area-message txt))))
1044
1045 (defun tabkey2-timer-deliver-message (txt where)
1046   "Show message TXT to user.
1047 Protect from errors cause this is run during a timer."
1048   (save-match-data ;; runs in timer
1049     (when (and tabkey2-completion-state-mode
1050                (equal (point-marker) where))
1051       (condition-case err
1052           (tabkey2-deliver-message txt)
1053         (error (message "tabkey2-timer-deliver-message: %s"
1054                         (error-message-string err)))))))
1055
1056 (defvar tabkey2-delayed-timer nil)
1057
1058 (defun tabkey2-cancel-delayed-message ()
1059   "Cancel delayed message."
1060   (when tabkey2-delayed-timer
1061     (cancel-timer tabkey2-delayed-timer)
1062     (setq tabkey2-delayed-timer)))
1063
1064 (defun tabkey2-maybe-delayed-message (txt delay)
1065   "Show message TXT, delay it if DELAY is non-nil."
1066   (if delay
1067       (setq tabkey2-delayed-timer
1068             (run-with-idle-timer
1069              delay nil
1070              'tabkey2-timer-deliver-message txt (point-marker)))
1071     (tabkey2-deliver-message txt)))
1072
1073 (defun tabkey2-message (delay format-string &rest args)
1074   "Show, if DELAY delayed, otherwise immediately message.
1075 FORMAT-STRING and ARGS are like for `message'."
1076   (let ((txt (apply 'format format-string args)))
1077     (tabkey2-maybe-delayed-message txt delay)))
1078
1079 (defun tabkey2-show-current-message (&optional delay)
1080   "Show current completion message, delayed if DELAY is non-nil."
1081   (tabkey2-cancel-delayed-message)
1082   (tabkey2-message delay "%s" tabkey2-current-tab-info))
1083
1084
1085 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1086 ;;;; Completion function selection etc
1087
1088 (defun tabkey2-symbol-keys (comp-fun)
1089   "Get a list of all key bindings for COMP-FUN."
1090   (let* ((remapped (command-remapping comp-fun)))
1091     (where-is-internal comp-fun
1092                        nil ;;overriding-local-map
1093                        nil nil remapped)))
1094
1095 (defun tabkey2-get-active-completion-functions ()
1096   "Get a list of active completion functions.
1097 Consider only those in `tabkey2-completion-functions'."
1098   (delq nil
1099         (mapcar (lambda (rec)
1100                   (let ((fun (nth 1 rec))
1101                         (chk (nth 2 rec)))
1102                     (when (tabkey2-is-active fun chk) rec)))
1103                 tabkey2-completion-functions)))
1104
1105 (defun tabkey2-make-current-default ()
1106   "Make current Tab completion function default.
1107 Set the current Tab completion function at point as default for
1108 the current buffer."
1109   (interactive)
1110   (let ((set-it
1111          (y-or-n-p
1112           (format
1113            "Make %s default for Tab completion in current buffer? "
1114            tabkey2-current-tab-function))))
1115     (when set-it
1116       (setq tabkey2-chosen-completion-function
1117             tabkey2-current-tab-function))
1118     (unless set-it
1119       (when (local-variable-p 'tabkey2-chosen-completion-function)
1120         (when (y-or-n-p "Use default Tab completion selection in buffer? ")
1121           (setq set-it t))
1122         (kill-local-variable 'tabkey2-chosen-completion-function)))
1123     (when (tabkey2-completion-state-p)
1124       (tabkey2-message nil "%s%s" tabkey2-current-tab-info
1125                        (if set-it " - Done" "")))))
1126
1127 (defun tabkey2-activate-next-completion-function (wrap)
1128   (let* ((active (mapcar (lambda (rec)
1129                            (nth 1 rec))
1130                          (tabkey2-get-active-completion-functions)))
1131          (first (car active))
1132          next)
1133     ;;(message "is-shown=%s current=%s active=%s overlay=%s" tabkey2-message-is-shown tabkey2-current-tab-function active tabkey2-overlay)
1134     (when tabkey2-current-tab-function
1135       (while (and active (not next))
1136         (when (eq (car active) tabkey2-current-tab-function)
1137           (setq next (cadr active)))
1138         (setq active (cdr active))))
1139     (unless next
1140       (when wrap (setq next first)))
1141     ;;(if (eq first next)
1142     (tabkey2-make-message-and-set-fun next)))
1143
1144 (defun tabkey2-cycle-completion-functions (prefix)
1145   "Cycle through cnd display ompletion functions.
1146 If 'Tab completion state' is not on then turn it on.
1147
1148 If PREFIX is given just show what this command will do."
1149   (interactive "P")
1150   (if (tabkey2-read-only-p)
1151       (message "Buffer is read only at point")
1152     (unless tabkey2-completion-state-mode (tabkey2-completion-state-mode 1))
1153     (save-match-data
1154       (if prefix
1155           ;; fix-me
1156           (message "(TabKey2) %s: show/cycle completion function"
1157                    last-input-event)
1158         (when tabkey2-message-is-shown
1159             ;; Message is shown currently so change
1160             (tabkey2-activate-next-completion-function 'wrap))
1161         (tabkey2-show-current-message)))))
1162
1163
1164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1165 ;;;; Handling of Tab and alternate key
1166
1167 ;;;###autoload
1168 (defun tabkey2-emma-without-tabkey2 ()
1169   ;; Remove keymaps from tabkey2 in this copy:
1170   (delq 'tabkey2--emul-keymap-alist
1171         (copy-sequence emulation-mode-map-alists)))
1172
1173 (defvar tabkey2-step-out-of-the-way nil)
1174 ;;(remove-hook 'pre-command-hook 'tabkey2-pre-command)
1175 ;;(remove-hook 'post-command-hook 'tabkey2-pre-command)
1176 ;;(remove-hook 'post-command-hook 'tabkey2-post-command-2)
1177 (defun tabkey2-post-command ()
1178   (setq tabkey2-step-out-of-the-way nil)
1179   (condition-case err
1180       (when tabkey2-mode
1181         (when (and (boundp 'company-overriding-keymap-bound) company-overriding-keymap-bound)
1182           (setq tabkey2-step-out-of-the-way
1183                 (let ((emulation-mode-map-alists (tabkey2-emma-without-tabkey2)))
1184                   (key-binding (this-command-keys))))
1185           ;;(message "tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
1186           ))
1187     (error "tabkey2-pre-command: %s" err)))
1188   ;; (and (boundp 'company-preview-overlay)
1189   ;;                                    (or company-preview-overlay
1190   ;;                                        company-pseudo-tooltip-overlay)))
1191 (defun tabkey2-first (prefix)
1192   "Do something else after first Tab.
1193 This function is bound to the Tab key \(or whatever key
1194 `tabkey2-first-key' is) when minor mode command `tabkey2-mode' is
1195 on.  It works like this:
1196
1197 1. The first time Tab is pressed do whatever Tab would have done
1198    if minor mode command `tabkey2-mode' was off.
1199
1200    Then before next command enter a new temporary 'Tab completion
1201    state' for just the next command.  Show this by a highlight on
1202    the indentation and a marker \"Tab2\" in the mode line.
1203
1204    However if either
1205    - the minibuffer is active and `tabkey2-in-minibuffer' is nil
1206    - `major-mode' is in `tabkey2-modes-that-use-more-tabs' then
1207      do not enter this temporary 'Tab completion state'.
1208
1209    For major modes where it make sense to press Tab several times
1210    you can use `tabkey2-alternate-key' to enter 'Tab completion
1211    state'.
1212
1213
1214 2. As long as point is not move do completion when Tab is pressed
1215    again.  Show that this state is active with a highlighting at
1216    the line beginning, a marker on the mode line (Tab2) and a
1217    message in the echo area which tells what kind of completion
1218    will be done.
1219
1220    When deciding what kind of completion to do look in the table
1221    below and do whatever it found first that is not nil:
1222
1223    - `tabkey2-preferred'
1224    - `tabkey2-completion-functions'
1225    - `tabkey2-fallback'
1226
1227 3. Of course, there must be some way for you to easily determine
1228    what kind of completion because there are many in Emacs. If
1229    you do not turn it off this function will show that to you.
1230    And if you turn it off you can still display it, see the key
1231    bindings below.
1232
1233    If this function is used with a PREFIX argument then it just
1234    shows what Tab will do.
1235
1236    If the default kind of completion is not what you want then
1237    you can choose completion function from any of the candidates
1238    in `tabkey2-completion-functions'.  During the 'Tab completion
1239    state' the following extra key bindings are available:
1240
1241 \\{tabkey2-completion-state-emul-map}
1242
1243 Of course, some languages does not have a fixed indent as is
1244 assumed above. You can put major modes for those in
1245 `tabkey2-modes-that-just-complete'.
1246
1247 Some major modes uses tab for something else already. Those are
1248 in `tabkey2-modes-that-use-more-tabs'.  There is an alternate
1249 key, `tabkey2-alternate-key' if you want to do completion
1250 there. Note that this key does not do completion. It however
1251 enters 'Tab completion state' in which you have access to the
1252 keys above for completion etc. \(This key also lets you cycle
1253 through the completion functions too choose which one to use.)
1254
1255 -----
1256 NOTE: This uses `emulation-mode-map-alists' and it supposes that
1257 nothing else is bound to Tab there."
1258   (interactive "P")
1259   ;;(message "first:tabkey2-step-out=%s, %s" (this-command-keys) tabkey2-step-out-of-the-way)
1260   (if tabkey2-step-out-of-the-way
1261       (progn
1262         (message "step-out=%s" tabkey2-step-out-of-the-way)
1263         (call-interactively tabkey2-step-out-of-the-way))
1264   (if (and tabkey2-keymap-overlay
1265            (eq (overlay-buffer tabkey2-keymap-overlay) (current-buffer))
1266            (eq (overlay-get tabkey2-keymap-overlay 'window) (selected-window))
1267            (>= (point) (overlay-start tabkey2-keymap-overlay))
1268            (<= (point) (overlay-end   tabkey2-keymap-overlay)))
1269       ;; We should maybe not be here, but the keymap does not work at
1270       ;; the end of the buffer so we call the second tab function from
1271       ;; here:
1272       (if (memq 'shift (event-modifiers last-input-event))
1273           (call-interactively 'tabkey2-cycle-completion-functions)
1274         (call-interactively 'tabkey2-complete prefix))
1275     (let* ((emma-without-tabkey2 (tabkey2-emma-without-tabkey2))
1276            (at-word-end (looking-at "\\_>"))
1277            (just-complete (or (memq major-mode tabkey2-modes-that-just-complete)
1278                               at-word-end))
1279            (what (if just-complete
1280                      'complete
1281                    (if (or (unless tabkey2-in-minibuffer
1282                              (active-minibuffer-window))
1283                            (when (fboundp 'use-region-p) (use-region-p))
1284                            (not at-word-end)
1285                            (memq major-mode tabkey2-modes-that-use-more-tabs))
1286                        'indent
1287                      'indent-complete
1288                      )))
1289            (to-do-1 (unless (or
1290                              ;; Skip action on tab if shift tab,
1291                              ;; backtab or a mode in the "just
1292                              ;; complete" list
1293                              (memq 'shift (event-modifiers last-input-event))
1294                              (equal [backtab] (this-command-keys-vector))
1295                              )
1296                       (let ((emulation-mode-map-alists emma-without-tabkey2))
1297                         ;; Fix-me: Is this the way to pick up "tab keys"?
1298                         (or (key-binding [tab] t)
1299                             (key-binding [?\t] t))
1300                         )))
1301            (to-do-2 (unless (or ;;(memq what '(complete))
1302                                 (memq what '(indent))
1303                                 (memq to-do-1 '(widget-forward button-forward)))
1304                       (tabkey2-get-default-completion-fun))))
1305       ;;(message "step-out-of-the-way=%s to-do=%s/%s, emmaa-without-tabkey2=%s" step-out-of-the-way to-do-1 to-do-2 emma-without-tabkey2)
1306       (if prefix
1307           (if (memq 'shift (event-modifiers last-input-event))
1308               (message
1309                "(TabKey2) First shift %s: turn on 'Tab completion state'"
1310                last-input-event)
1311             (message "(TabKey2) First %s: %s, next: maybe %s"
1312                      last-input-event to-do-1
1313                      (if to-do-2 to-do-2 "(same)")))
1314         (when to-do-1
1315           (let (xmumamo-multi-major-mode)
1316               (tabkey2-call-interactively to-do-1)))
1317         (unless (tabkey2-read-only-p)
1318           (when to-do-2
1319             (tabkey2-completion-state-mode 1))))))))
1320
1321 (defun tabkey2-call-interactively (function)
1322   "Like `call-interactively, but handle `this-command'."
1323   (setq this-command function)
1324   (call-interactively function))
1325
1326 (defcustom tabkey2-choose-next-on-error t
1327   "Choose next completion function on error."
1328   :type 'boolean
1329   :group 'tabkey2)
1330
1331 (defun tabkey2-complete (prefix)
1332   "Call current completion function.
1333 If used with a PREFIX argument then just show what Tab will do."
1334   (interactive "P")
1335   (if (and (boundp 'mumamo-multi-major-mode)
1336            mumamo-multi-major-mode
1337            (not (mumamo-syntax-maybe-completable (point))))
1338       (message "Please move out of chunk border before trying to complete.")
1339     (if prefix
1340         (message "(TabKey2) %s: %s"
1341                  last-input-event tabkey2-current-tab-function)
1342       (let ((here (point))
1343             (res (if tabkey2-choose-next-on-error
1344                      (condition-case err
1345                          (tabkey2-call-interactively tabkey2-current-tab-function)
1346                        (error (message "%s" (error-message-string err))
1347                               nil))
1348                    (tabkey2-call-interactively tabkey2-current-tab-function))))
1349         (when (and (not res) (= here (point)))
1350           (tabkey2-activate-next-completion-function nil)
1351           ;;(message "complete.tabkey2-current-tab-function=%s" tabkey2-current-tab-function)
1352           (if tabkey2-current-tab-function
1353               (tabkey2-show-current-message)
1354             (message "No more active completion functions in this buffer")))))))
1355
1356 ;; Fix-me: I am not sure that it really is useful with a globalized
1357 ;; minor mode here because there are so many other ways to control
1358 ;; what happens in a specific buffer. Maybe it would just be
1359 ;; confusing?
1360 ;;
1361 ;; If found another problem with making it globalized: tabkey2-mode
1362 ;; uses emulation-mode-map-alist.  I decided to remove this therefore.
1363 ;;
1364 ;; (defun tabkey2-turn-on ()
1365 ;;   "Turn on `tabkey2-mode' in current buffer."
1366 ;;   (tabkey2-mode 1))
1367
1368 ;; (defvar tabkey2-turn-on-function 'tabkey2-turn-on
1369 ;;   "Function used to mabye turn on `tabkey2-mode' in current-buffer.
1370 ;; This function is used by `tabkey2-global-mode' to turn on
1371 ;; `tabkey2-mode'.")
1372
1373 ;; (defun tabkey2-turn-on-in-buffer ()
1374 ;;   (funcall tabkey2-turn-on-function))
1375
1376 ;; (define-globalized-minor-mode tabkey2-global-mode
1377 ;;   tabkey2-mode tabkey2-turn-on-in-buffer)
1378
1379 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1380 ;;;; Help functions
1381
1382 (defun tabkey2-show-completion-state-help ()
1383   "Help for 'Tab completion state'.
1384 To get out of this state you can move out of the current line.
1385
1386 During this state the keymap below is active.  This state stops
1387 as soon as you leave the current row.
1388
1389 \\{tabkey2-completion-state-emul-map}
1390 See function `tabkey2-mode' for more information.
1391
1392 If you want to use Emacs normal help function then press F1
1393 again.")
1394
1395 (defun tabkey2-completion-state-help ()
1396   "Show help for 'Tab completion state'."
1397   (interactive)
1398   ;;(message "tckv=%s" (this-command-keys-vector)) ;;(sit-for 1)
1399   ;; Fix-me: There seems to be an Emacs bug lurking here. Sometimes
1400   ;; invoked-by-f1 is not [f1].
1401   (let ((invoked-by-f1 (equal (this-command-keys-vector) [f1]))
1402         normal-help)
1403     ;;(message "invoked-by-f1=%s" invoked-by-f1) ;; fix-me
1404     (if (not invoked-by-f1)
1405         (describe-function 'tabkey2-show-completion-state-help)
1406       (setq normal-help
1407             (read-event
1408              (propertize
1409               (concat "Type a key for Emacs help."
1410                       " Or, wait for Tab completion state help: ")
1411               'face 'highlight)
1412              nil
1413              4))
1414       (case normal-help
1415         ((nil)
1416          ;;(message "Tab completion state help")
1417          (describe-function 'tabkey2-show-completion-state-help))
1418         (?c
1419          (call-interactively 'describe-key-briefly))
1420         (?k
1421          (call-interactively 'describe-key))
1422         (t
1423          (tabkey2-completion-state-mode -1)
1424          (setq unread-command-events
1425                (reverse
1426                 (cons
1427                  normal-help
1428                  (append (this-command-keys) nil)))))))))
1429
1430 (defun tabkey2-completion-function-help ()
1431   "Show help for current completion function."
1432   (interactive)
1433   (describe-function tabkey2-current-tab-function))
1434
1435
1436
1437
1438 (defun tabkey2-get-key-binding (fun t2)
1439   "Get key binding for FUN during 'Tab completion state'."
1440   (let* ((remapped (command-remapping fun))
1441          (key (where-is-internal fun
1442                                  (when t2 tabkey2-completion-state-emul-map)
1443                                  t
1444                                  nil
1445                                  remapped)))
1446     key))
1447
1448 ;; (defun tabkey2-reset-completion-function (comp-fun)
1449 ;;   "Reset states for functions in `tabkey2-completion-functions'."
1450 ;; ;; Fix-me: remove hard-coding
1451 ;;   (setq dabbrev--last-abbrev-location nil))
1452
1453 (defun tabkey2-make-message-and-set-fun (comp-fun)
1454   "Set current completion function to COMP-FUN.
1455 Build message but don't show it."
1456   ;;(tabkey2-reset-completion-functions)
1457   (let* ((chs-fun 'tabkey2-cycle-completion-functions)
1458          (key (tabkey2-get-key-binding chs-fun t))
1459          ;;(def-fun (tabkey2-get-default-completion-fun))
1460          what
1461          (comp-fun-key (tabkey2-get-key-binding comp-fun nil))
1462          reset)
1463     (setq tabkey2-current-tab-function comp-fun)
1464     (dolist (rec tabkey2-completion-functions)
1465       (let ((fun (nth 1 rec))
1466             (txt (nth 0 rec))
1467             (res (nth 3 rec)))
1468         (when (eq fun comp-fun)
1469           (eval res)
1470           (setq what txt))))
1471     (let ((info (concat (format "Tab: %s" what)
1472                         (if comp-fun-key
1473                             (format " (%s)" (key-description comp-fun-key))
1474                           "")
1475                         (if (cdr (tabkey2-get-active-completion-functions))
1476                             (format ", other %s, help F1"
1477                                     (key-description key))
1478                           ""))))
1479       (setq tabkey2-current-tab-info info))))
1480
1481 (defun tabkey2-get-active-string (bnd fun buf)
1482   "Get string to show for state.
1483 BND: means active
1484 FUN: function
1485 BUF: buffer"
1486   (if bnd
1487       (if (with-current-buffer buf (tabkey2-read-only-p))
1488           (propertize "active, but read-only" 'face '( :foreground "red"))
1489         (propertize "active" 'face '( :foreground "green3")))
1490     (if (and (fboundp fun)
1491              (commandp fun))
1492         (propertize "not active" 'face '( :foreground "red2"))
1493       (propertize "not defined" 'face '( :foreground "gray")))))
1494
1495 (defun tabkey2-show-completion-functions ()
1496   "Show what currently may be used for completion."
1497   (interactive)
1498   (let ((orig-buf (current-buffer))
1499         (orig-mn  mode-name)
1500         (active-mark (concat " "
1501                              (propertize "<= default"
1502                                          'face '( :background "yellow"))))
1503         (act-found nil)
1504         (chosen-fun tabkey2-chosen-completion-function)
1505         what
1506         chosen)
1507     (when chosen-fun
1508       (dolist (rec tabkey2-completion-functions)
1509         (let ((fun (nth 1 rec))
1510               (txt (nth 0 rec)))
1511           (when (eq fun chosen-fun) (setq what txt))))
1512       (setq chosen (list what chosen-fun)))
1513     (with-output-to-temp-buffer (help-buffer)
1514       (help-setup-xref (list #'tabkey2-show-completion-functions)
1515                        (interactive-p))
1516       (with-current-buffer (help-buffer)
1517         (insert (concat "The completion functions available for"
1518                         " 'Tab completion' in buffer\n'"
1519                 (buffer-name orig-buf)
1520                 "' at point with mode " orig-mn " are shown below.\n"
1521                 "The first active function is used by default.\n\n"))
1522         (if (not chosen)
1523             (insert "  No completion function is set as default.")
1524           (let* ((txt (nth 0 chosen))
1525                  (fun (nth 1 chosen))
1526                  (chk (nth 2 chosen))
1527                  (bnd (with-current-buffer orig-buf
1528                         (tabkey2-is-active fun chk)))
1529                  (act (tabkey2-get-active-string bnd fun orig-buf)))
1530             (insert (format "  Default is set to\n    %s (%s): %s"
1531                             txt fun act))
1532             (when bnd (insert active-mark) (setq act-found t))))
1533         (insert "\n\n")
1534 ;;;         (if (not tabkey2-preferred)
1535 ;;;             (insert "  None is preferred")
1536 ;;;           (let* ((txt (nth 0 tabkey2-preferred))
1537 ;;;                  (fun (nth 1 tabkey2-preferred))
1538 ;;;                  (chk (nth 2 chosen))
1539 ;;;                  (bnd (with-current-buffer orig-buf
1540 ;;;                         (tabkey2-is-active fun chk)))
1541 ;;;                  (act (tabkey2-get-active-string bnd fun orig-buf)))
1542 ;;;             (insert (format "  Preferred is %s (`%s')': %s"
1543 ;;;                             txt fun act))
1544 ;;;             (when bnd (insert active-mark) (setq act-found t))))
1545 ;;;         (insert "\n\n")
1546         (dolist (comp-fun tabkey2-completion-functions)
1547           (let* ((txt (nth 0 comp-fun))
1548                  (fun (nth 1 comp-fun))
1549                  (chk (nth 2 comp-fun))
1550                  (bnd (with-current-buffer orig-buf
1551                         (tabkey2-is-active fun chk)))
1552                  (act (tabkey2-get-active-string bnd fun orig-buf))
1553                  (keys (where-is-internal fun)))
1554             (if (not keys)
1555                 (setq keys "")
1556               (setq keys (mapconcat 'key-description keys ", "))
1557               (when (and (< 9 (length keys))
1558                          (string= "<menu-bar>" (substring keys 0 10)))
1559                 (setq keys "Menu"))
1560               (setq keys (propertize keys 'face 'highlight))
1561               (setq keys (concat ", " keys))
1562               )
1563             (insert
1564              (format
1565               "  %s (`%s'%s): %s"
1566               txt fun keys act))
1567             (when (and (not act-found) bnd)
1568               (insert active-mark) (setq act-found t))
1569             (insert "\n")))
1570         (insert "\n")
1571         (if (not tabkey2-fallback)
1572             (insert "  There is no fallback")
1573           (let* ((txt (nth 0 tabkey2-fallback))
1574                  (fun (nth 1 tabkey2-fallback))
1575                  (chk (nth 2 tabkey2-fallback))
1576                  (bnd (with-current-buffer orig-buf
1577                         (tabkey2-is-active fun chk)))
1578                  (act (tabkey2-get-active-string bnd fun orig-buf)))
1579             (insert (format "  Fallback is %s (`%s'): %s"
1580                             txt fun act))
1581             (when (and (not act-found) bnd)
1582               (insert active-mark)
1583               (setq act-found t))))
1584         (insert "\n\nYou an ")
1585         (insert-text-button "customize this list"
1586                             'action (lambda (button)
1587                                       (customize-option
1588                                        'tabkey2-completion-functions)))
1589         (insert ".\nSee function `tabkey2-mode' for more information.")
1590         (with-no-warnings (print-help-return-message))))))
1591
1592 (defvar tabkey2-completing-read 'completing-read)
1593
1594 (defun tabkey2-set-fun (fun)
1595   "Use function FUN for Tab in 'Tab completion state'."
1596   (setq tabkey2-chosen-completion-function fun)
1597   (unless fun
1598     (setq fun (tabkey2-first-active-from-completion-functions)))
1599   (tabkey2-make-message-and-set-fun fun)
1600   (when (tabkey2-completion-state-p)
1601     (message "%s" tabkey2-current-tab-info)))
1602
1603 (defun tabkey2-appmenu ()
1604   "Make a menu for minor mode command `appmenu-mode'."
1605   (unless (tabkey2-read-only-p)
1606     (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
1607            (tit "Complete")
1608            (map (make-sparse-keymap tit)))
1609       (define-key map [tabkey2-usage]
1610         (list 'menu-item "Show Available Completion Functions for TabKey2"
1611               'tabkey2-show-completion-functions))
1612       (define-key map [tabkey2-divider-1] (list 'menu-item "--"))
1613       (let ((set-map (make-sparse-keymap "Set Completion")))
1614         (define-key map [tabkey2-choose]
1615           (list 'menu-item "Set Primary TabKey2 Tab Completion in Buffer" set-map))
1616         (dolist (cf-rec cf-r)
1617           (let ((dsc (nth 0 cf-rec))
1618                 (fun (nth 1 cf-rec)))
1619             (define-key set-map
1620               (vector (intern (format "tabkey2-set-%s" fun)))
1621               (list 'menu-item dsc
1622                     `(lambda ()
1623                        (interactive)
1624                        (tabkey2-set-fun ',fun))
1625                     :button
1626                     `(:radio
1627                       . (eq ',fun tabkey2-chosen-completion-function))))))
1628         (define-key set-map [tabkey2-set-div] (list 'menu-item "--"))
1629         (define-key set-map [tabkey2-set-default]
1630           (list 'menu-item "Default Tab completion"
1631                 (lambda ()
1632                   (interactive)
1633                   (tabkey2-set-fun nil))
1634                 :button
1635                 '(:radio . (null tabkey2-chosen-completion-function))))
1636         (define-key set-map [tabkey2-set-header-div] (list 'menu-item "--"))
1637         (define-key set-map [tabkey2-set-header]
1638           (list 'menu-item "Set Primary Tab Completion for Buffer"))
1639         )
1640       (define-key map [tabkey2-divider] (list 'menu-item "--"))
1641       (dolist (cf-rec cf-r)
1642         (let ((dsc (nth 0 cf-rec))
1643               (fun (nth 1 cf-rec)))
1644           (define-key map
1645             (vector (intern (format "tabkey2-call-%s" fun)))
1646             (list 'menu-item dsc fun
1647                   :button
1648                   `(:toggle
1649                     . (eq ',fun tabkey2-chosen-completion-function))
1650                   ))))
1651       map)))
1652
1653 ;; (defun tabkey2-completion-menu-popup ()
1654 ;;   "Pop up a menu with completion alternatives."
1655 ;;   (interactive)
1656 ;;   (let ((menu (tabkey2-appmenu)))
1657 ;;     (popup-menu-at-point menu)))
1658
1659 ;; (defun tabkey2-choose-completion-function ()
1660 ;;   "Set current completion function.
1661 ;; Let user choose completion function from those in
1662 ;; `tabkey2-completion-functions' that have some key binding at
1663 ;; point.
1664
1665 ;; Let the chosen completion function be the default for subsequent
1666 ;; completions in the current buffer."
1667 ;;   ;; Fix-me: adjust to mumamo.
1668 ;;   (interactive)
1669 ;;   (save-match-data
1670 ;;     (if (and (featurep 'popcmp)
1671 ;;              tabkey2-use-popup-menus)
1672 ;;         (tabkey2-completion-menu-popup)
1673 ;;       (when (eq 'completing-read tabkey2-completing-read) (isearch-unread 'tab))
1674 ;;       (let* ((cf-r (reverse (tabkey2-get-active-completion-functions)))
1675 ;;              (cf (cons '("- Use default Tab completion" nil) cf-r))
1676 ;;              (hist (mapcar (lambda (rec)
1677 ;;                              (car rec))
1678 ;;                            cf))
1679 ;;              (tit (funcall tabkey2-completing-read "Set current completion function: " cf
1680 ;;                            nil ;; predicate
1681 ;;                            t   ;; require-match
1682 ;;                            nil ;; initial-input
1683 ;;                            'hist ;; hist
1684 ;;                            ))
1685 ;;              (fun-rec (assoc-string tit cf))
1686 ;;              (fun (cadr fun-rec)))
1687 ;;         (setq tabkey2-chosen-completion-function fun)
1688 ;;         (unless fun
1689 ;;           (setq fun (tabkey2-first-active-from-completion-functions)))
1690 ;;         (tabkey2-make-message-and-set-fun fun)
1691 ;;         (when (tabkey2-completion-state-p)
1692 ;;           (tabkey2-show-current-message))))))
1693
1694 ;; (defun tabkey2-add-to-appmenu ()
1695 ;;   "Add a menu to function `appmenu-mode'."
1696 ;;   (appmenu-add 'tabkey2 nil t "Completion" 'tabkey2-appmenu))
1697
1698
1699 (provide 'tabkey2)
1700 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1701 ;;; tabkey2.el ends here